🔥 emptyEnv.

src/Data/Abstract/Environment.hs

@@ -3,7 +3,6 @@ module Data.Abstract.Environment
   , addresses
   , delete
   , head
-  , emptyEnv
   , mergeEnvs
   , mergeNewer
   , insert
@@ -29,7 +28,7 @@ import           Prologue
 
 -- $setup
 -- >>> import Data.Abstract.Address
--- >>> let bright = push (insert (name "foo") (Precise 0) emptyEnv)
+-- >>> let bright = push (insert (name "foo") (Precise 0) lowerBound)
 -- >>> let shadowed = insert (name "foo") (Precise 1) bright
 
 -- | A LIFO stack of maps of names to addresses, representing a lexically-scoped evaluation environment.
@@ -42,16 +41,13 @@ mergeEnvs :: Environment address -> Environment address -> Environment address
 mergeEnvs (Environment (a :| as)) (Environment (b :| bs)) =
   Environment ((<>) a b :| alignWith (mergeThese (<>)) as bs)
 
-emptyEnv :: Environment address
-emptyEnv = Environment (lowerBound :| [])
-
 -- | Make and enter a new empty scope in the given environment.
 push :: Environment address -> Environment address
 push (Environment (a :| as)) = Environment (mempty :| a : as)
 
 -- | Remove the frontmost scope.
 pop :: Environment address -> Environment address
-pop (Environment (_ :| []))     = emptyEnv
+pop (Environment (_ :| []))     = lowerBound
 pop (Environment (_ :| a : as)) = Environment (a :| as)
 
 -- | Drop all scopes save for the frontmost one.
@@ -125,7 +121,7 @@ addresses :: Ord address => Environment address -> Live address
 addresses = fromAddresses . map snd . pairs
 
 
-instance Lower (Environment address) where lowerBound = emptyEnv
+instance Lower (Environment address) where lowerBound = Environment (lowerBound :| [])
 
 instance Show address => Show (Environment address) where
   showsPrec d = showsUnaryWith showsPrec "Environment" d . pairs

src/Data/Abstract/Evaluatable.hs

@@ -118,15 +118,15 @@ evaluatePackageWith analyzeModule analyzeTerm package
         evaluateEntryPoint :: Environment address -> ModulePath -> Maybe Name -> TermEvaluator term address value inner'' (address, Environment address)
         evaluateEntryPoint preludeEnv m sym = runInModule preludeEnv (ModuleInfo m) . TermEvaluator $ do
           addr <- box unit -- TODO don't *always* allocate - use maybeM instead
-          (ptr, env) <- fromMaybe (addr, emptyEnv) <$> require m
+          (ptr, env) <- fromMaybe (addr, lowerBound) <$> require m
           bindAll env
           maybe (pure ptr) ((`call` []) <=< deref <=< variable) sym
 
-        evalPrelude prelude = raiseHandler (runModules (runTermEvaluator . evalModule emptyEnv)) $ do
-          (_, builtinsEnv) <- runInModule emptyEnv moduleInfoFromCallStack (TermEvaluator (defineBuiltins *> box unit))
+        evalPrelude prelude = raiseHandler (runModules (runTermEvaluator . evalModule lowerBound)) $ do
+          (_, builtinsEnv) <- runInModule lowerBound moduleInfoFromCallStack (TermEvaluator (defineBuiltins *> box unit))
           second (mergeEnvs builtinsEnv) <$> evalModule builtinsEnv prelude
 
-        withPrelude Nothing f = f emptyEnv
+        withPrelude Nothing f = f lowerBound
         withPrelude (Just prelude) f = do
           (_, preludeEnv) <- evalPrelude prelude
           f preludeEnv

src/Data/Abstract/Type.hs

@@ -10,6 +10,7 @@ module Data.Abstract.Type
 import Control.Abstract
 import Data.Abstract.Environment as Env
 import Data.Semigroup.Foldable (foldMap1)
+import Data.Semilattice.Lower
 import Prologue hiding (TypeError)
 
 type TName = Int
@@ -126,7 +127,7 @@ instance ( Member (Allocator address Type) effects
       addr <- alloc name
       tvar <- Var <$> fresh
       assign addr tvar
-      bimap (Env.insert name addr) (tvar :) <$> rest) (pure (emptyEnv, [])) names
+      bimap (Env.insert name addr) (tvar :) <$> rest) (pure (lowerBound, [])) names
     (zeroOrMoreProduct tvars :->) <$> (deref =<< locally (bindAll env *> body `catchReturn` \ (Return ptr) -> pure ptr))
 
   call op params = do
@@ -158,7 +159,7 @@ instance ( Member (Allocator address Type) effects
   klass _ _ _   = pure Object
   namespace _ _ = pure Unit
 
-  scopedEnvironment _ = pure (Just emptyEnv)
+  scopedEnvironment _ = pure (Just lowerBound)
 
   asString t = unify t String $> ""
   asPair t   = do

src/Data/Abstract/Value.hs

@@ -2,7 +2,7 @@
 module Data.Abstract.Value where
 
 import Control.Abstract
-import Data.Abstract.Environment (Environment, emptyEnv, mergeEnvs)
+import Data.Abstract.Environment (Environment, mergeEnvs)
 import qualified Data.Abstract.Environment as Env
 import Data.Abstract.Name
 import qualified Data.Abstract.Number as Number
@@ -10,6 +10,7 @@ import Data.Coerce
 import Data.List (genericIndex, genericLength)
 import Data.Scientific (Scientific)
 import Data.Scientific.Exts
+import Data.Semilattice.Lower
 import qualified Data.Set as Set
 import Prologue
 
@@ -120,12 +121,12 @@ instance ( Coercible body (Eff effects)
 
   klass n [] env = pure $ Class n env
   klass n supers env = do
-    product <- foldl mergeEnvs emptyEnv . catMaybes <$> traverse scopedEnvironment supers
+    product <- foldl mergeEnvs lowerBound . catMaybes <$> traverse scopedEnvironment supers
     pure $ Class n (mergeEnvs product env)
 
   namespace n env = do
     maybeAddr <- lookupEnv n
-    env' <- maybe (pure emptyEnv) (asNamespaceEnv <=< deref) maybeAddr
+    env' <- maybe (pure lowerBound) (asNamespaceEnv <=< deref) maybeAddr
     pure (Namespace n (Env.mergeNewer env' env))
     where asNamespaceEnv v
             | Namespace _ env' <- v = pure env'

src/Language/Go/Syntax.hs

@@ -7,6 +7,7 @@ import qualified Data.Abstract.Package as Package
 import           Data.Abstract.Path
 import           Data.Aeson
 import           Data.JSON.Fields
+import           Data.Semilattice.Lower
 import qualified Data.Text as T
 import           Diffing.Algorithm
 import           Prologue
@@ -66,7 +67,7 @@ instance Evaluatable Import where
     paths <- resolveGoImport importPath
     for_ paths $ \path -> do
       traceResolve (unPath importPath) path
-      importedEnv <- maybe emptyEnv snd <$> require path
+      importedEnv <- maybe lowerBound snd <$> require path
       bindAll importedEnv
     rvalBox unit
 
@@ -88,7 +89,7 @@ instance Evaluatable QualifiedImport where
     void $ letrec' alias $ \addr -> do
       for_ paths $ \p -> do
         traceResolve (unPath importPath) p
-        importedEnv <- maybe emptyEnv snd <$> require p
+        importedEnv <- maybe lowerBound snd <$> require p
         bindAll importedEnv
       makeNamespace alias addr Nothing
     rvalBox unit

src/Language/PHP/Syntax.hs

@@ -7,6 +7,7 @@ import           Data.Abstract.Path
 import qualified Data.Text as T
 import           Data.JSON.Fields
 import qualified Data.Language as Language
+import           Data.Semilattice.Lower
 import           Diffing.Algorithm
 import           Prologue hiding (Text)
 
@@ -62,7 +63,7 @@ include pathTerm f = do
   path <- resolvePHPName name
   traceResolve name path
   unitPtr <- box unit -- TODO don't always allocate, use maybeM
-  (v, importedEnv) <- fromMaybe (unitPtr, emptyEnv) <$> f path
+  (v, importedEnv) <- fromMaybe (unitPtr, lowerBound) <$> f path
   bindAll importedEnv
   pure (Rval v)
 

src/Language/Python/Syntax.hs

@@ -10,6 +10,7 @@ import           Data.JSON.Fields
 import qualified Data.Language as Language
 import qualified Data.List.NonEmpty as NonEmpty
 import           Data.Mergeable
+import           Data.Semilattice.Lower
 import qualified Data.Text as T
 import           Diffing.Algorithm
 import           GHC.Generics
@@ -113,7 +114,7 @@ instance Evaluatable Import where
 
     -- Last module path is the one we want to import
     let path = NonEmpty.last modulePaths
-    importedEnv <- maybe emptyEnv snd <$> require path
+    importedEnv <- maybe lowerBound snd <$> require path
     bindAll (select importedEnv)
     rvalBox unit
     where
@@ -130,7 +131,7 @@ evalQualifiedImport :: ( AbstractValue address value effects
                        )
                     => Name -> ModulePath -> Evaluator address value effects value
 evalQualifiedImport name path = letrec' name $ \addr -> do
-  importedEnv <- maybe emptyEnv snd <$> require path
+  importedEnv <- maybe lowerBound snd <$> require path
   bindAll importedEnv
   unit <$ makeNamespace name addr Nothing
 
@@ -174,7 +175,7 @@ instance Evaluatable QualifiedAliasedImport where
     alias <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm aliasTerm)
     rvalBox =<< letrec' alias (\addr -> do
       let path = NonEmpty.last modulePaths
-      importedEnv <- maybe emptyEnv snd <$> require path
+      importedEnv <- maybe lowerBound snd <$> require path
       bindAll importedEnv
       unit <$ makeNamespace alias addr Nothing)
 

src/Language/Ruby/Syntax.hs

@@ -8,6 +8,7 @@ import           Data.Abstract.Path
 import qualified Data.Text as T
 import           Data.JSON.Fields
 import qualified Data.Language as Language
+import           Data.Semilattice.Lower
 import           Diffing.Algorithm
 import           Prologue
 import           System.FilePath.Posix
@@ -80,7 +81,7 @@ doRequire :: ( AbstractValue address value effects
 doRequire path = do
   result <- join <$> lookupModule path
   case result of
-    Nothing       -> (,) (boolean True) . maybe emptyEnv snd <$> load path
+    Nothing       -> (,) (boolean True) . maybe lowerBound snd <$> load path
     Just (_, env) -> pure (boolean False, env)
 
 
@@ -112,7 +113,7 @@ doLoad :: ( AbstractValue address value effects
 doLoad path shouldWrap = do
   path' <- resolveRubyPath path
   traceResolve path path'
-  importedEnv <- maybe emptyEnv snd <$> load path'
+  importedEnv <- maybe lowerBound snd <$> load path'
   unless shouldWrap $ bindAll importedEnv
   pure (boolean Prelude.True) -- load always returns true. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-load
 

src/Language/TypeScript/Syntax.hs

@@ -10,6 +10,7 @@ import           Data.Aeson
 import           Data.JSON.Fields
 import qualified Data.Language as Language
 import qualified Data.Map as Map
+import           Data.Semilattice.Lower
 import qualified Data.Text as T
 import           Diffing.Algorithm
 import           Prologue
@@ -139,7 +140,7 @@ evalRequire :: ( AbstractValue address value effects
             -> Name
             -> Evaluator address value effects value
 evalRequire modulePath alias = letrec' alias $ \addr -> do
-  importedEnv <- maybe emptyEnv snd <$> require modulePath
+  importedEnv <- maybe lowerBound snd <$> require modulePath
   bindAll importedEnv
   unit <$ makeNamespace alias addr Nothing
 
@@ -154,7 +155,7 @@ instance Show1 Import where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Import where
   eval (Import symbols importPath) = do
     modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions
-    importedEnv <- maybe emptyEnv snd <$> require modulePath
+    importedEnv <- maybe lowerBound snd <$> require modulePath
     bindAll (renamed importedEnv)
     rvalBox unit
     where
@@ -230,7 +231,7 @@ instance Show1 QualifiedExportFrom where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable QualifiedExportFrom where
   eval (QualifiedExportFrom importPath exportSymbols) = do
     modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions
-    importedEnv <- maybe emptyEnv snd <$> require modulePath
+    importedEnv <- maybe lowerBound snd <$> require modulePath
     -- Look up addresses in importedEnv and insert the aliases with addresses into the exports.
     for_ exportSymbols $ \(name, alias) -> do
       let address = Env.lookup name importedEnv

src/Semantic/Graph.hs

@@ -162,7 +162,7 @@ resumingValueError = runValueErrorWith (\ err -> trace ("ValueError" <> show err
   NumericError{}    -> pure hole
   Numeric2Error{}   -> pure hole
   ComparisonError{} -> pure hole
-  NamespaceError{}  -> pure emptyEnv
+  NamespaceError{}  -> pure lowerBound
   BitwiseError{}    -> pure hole
   Bitwise2Error{}   -> pure hole
   KeyValueError{}   -> pure (hole, hole)

test/Analysis/TypeScript/Spec.hs

@@ -27,7 +27,7 @@ spec = parallel $ do
 
     it "side effect only imports" $ do
       ((res, _), _) <- evaluate "main2.ts"
-      fmap snd <$> res `shouldBe` Right [emptyEnv]
+      fmap snd <$> res `shouldBe` Right [lowerBound]
 
     it "fails exporting symbols not defined in the module" $ do
       ((res, _), _) <- evaluate "bad-export.ts"