Merge remote-tracking branch 'origin/master' into eval-__FILE__

src/Control/Abstract/Analysis.hs

@@ -20,6 +20,7 @@ import Control.Monad.Effect.State as X
 import Control.Monad.Effect.Resumable as X
 import Data.Abstract.Module
 import Data.Coerce
+import Data.Empty as Empty
 import Data.Type.Coercion
 import Prologue
 
@@ -37,7 +38,7 @@ class MonadEvaluator location term value effects m => MonadAnalysis location ter
 
   -- | Isolate the given action with an empty global environment and exports.
   isolate :: m effects a -> m effects a
-  isolate = withEnv mempty . withExports mempty
+  isolate = withEnv Empty.empty . withExports Empty.empty
 
 
 -- | Lift a 'SubtermAlgebra' for an underlying analysis into a containing analysis. Use this when defining an analysis which can be composed onto other analyses to ensure that a call to 'analyzeTerm' occurs in the inner analysis and not the outer one.

src/Control/Abstract/Evaluator.hs

@@ -63,7 +63,7 @@ import Data.Abstract.Module
 import Data.Abstract.ModuleTable
 import Data.Abstract.Package
 import Data.Abstract.Origin
-import Data.Empty
+import Data.Empty as Empty
 import qualified Data.IntMap as IntMap
 import Data.Semigroup.Reducer
 import Lens.Micro
@@ -106,10 +106,10 @@ deriving instance (Ord (Cell location value), Ord location, Ord term, Ord value,
 deriving instance (Show (Cell location value), Show location, Show term, Show value, Show (Base term ())) => Show (EvaluatorState location term value)
 
 instance (Ord location, Semigroup (Cell location value)) => Semigroup (EvaluatorState location term value) where
-  EvaluatorState e1 h1 m1 l1 x1 j1 o1 <> EvaluatorState e2 h2 m2 l2 x2 j2 o2 = EvaluatorState (e1 <> e2) (h1 <> h2) (m1 <> m2) (l1 <> l2) (x1 <> x2) (j1 <> j2) (o1 <> o2)
+  EvaluatorState e1 h1 m1 l1 x1 j1 o1 <> EvaluatorState e2 h2 m2 l2 x2 j2 o2 = EvaluatorState (mergeEnvs e1 e2) (h1 <> h2) (m1 <> m2) (l1 <> l2) (x1 <> x2) (j1 <> j2) (o1 <> o2)
 
 instance (Ord location, Semigroup (Cell location value)) => Empty (EvaluatorState location term value) where
-  empty = EvaluatorState mempty mempty mempty mempty mempty mempty mempty
+  empty = EvaluatorState Empty.empty mempty mempty mempty mempty mempty mempty
 
 
 -- Lenses
@@ -183,7 +183,7 @@ withDefaultEnvironment e = raise . local (const e) . lower
 -- | Obtain an environment that is the composition of the current and default environments.
 --   Useful for debugging.
 fullEnvironment :: MonadEvaluator location term value effects m => m effects (Environment location value)
-fullEnvironment = mappend <$> getEnv <*> defaultEnvironment
+fullEnvironment = mergeEnvs <$> getEnv <*> defaultEnvironment
 
 -- | Run an action with a locally-modified environment.
 localEnv :: MonadEvaluator location term value effects m => (Environment location value -> Environment location value) -> m effects a -> m effects a

src/Control/Abstract/Value.hs

@@ -17,6 +17,7 @@ import Data.Abstract.Environment as Env
 import Data.Abstract.FreeVariables
 import Data.Abstract.Live (Live)
 import Data.Abstract.Number as Number
+import Data.Empty as Empty
 import Data.Scientific (Scientific)
 import Data.Semigroup.Reducer hiding (unit)
 import Prelude
@@ -177,10 +178,10 @@ makeNamespace :: ( MonadValue location value effects m
                  )
               => Name
               -> Address location value
-              -> [value]
+              -> Maybe value
               -> m effects value
-makeNamespace name addr supers = do
-  superEnv <- mconcat <$> traverse scopedEnvironment supers
+makeNamespace name addr super = do
+  superEnv <- maybe (pure Empty.empty) scopedEnvironment super
   namespaceEnv <- Env.head <$> getEnv
   v <- namespace name (Env.mergeNewer superEnv namespaceEnv)
   v <$ assign addr v

src/Data/Abstract/Environment.hs

@@ -5,12 +5,15 @@ module Data.Abstract.Environment
   , bind
   , delete
   , head
+  , emptyEnv
+  , mergeEnvs
   , mergeNewer
   , insert
   , lookup
   , names
   , overwrite
   , pairs
+  , unpairs
   , pop
   , push
   , roots
@@ -21,14 +24,14 @@ import           Data.Abstract.Address
 import           Data.Abstract.FreeVariables
 import           Data.Abstract.Live
 import           Data.Align
+import           Data.Empty as Empty
 import qualified Data.Map as Map
-import           Data.Semigroup.Reducer
 import           GHC.Exts (IsList (..))
 import           Prologue
 import qualified Data.List.NonEmpty as NonEmpty
 
 -- $setup
--- >>> let bright = push (insert (name "foo") (Address (Precise 0)) mempty)
+-- >>> let bright = push (insert (name "foo") (Address (Precise 0)) emptyEnv)
 -- >>> let shadowed = insert (name "foo") (Address (Precise 1)) bright
 
 -- | A LIFO stack of maps of names to addresses, representing a lexically-scoped evaluation environment.
@@ -49,18 +52,15 @@ instance IsList (Environment l a) where
   fromList xs                   = Environment (Map.fromList xs :| [])
   toList (Environment (x :| _)) = Map.toList x
 
--- TODO: property-check me
-instance Semigroup (Environment l a) where
-  Environment (a :| as) <> Environment (b :| bs) =
-    Environment ((a <> b) :| alignWith (mergeThese (<>)) as bs)
+instance Empty (Environment l a) where
+  empty = emptyEnv
 
-instance Reducer (Name, Address l a) (Environment l a) where
-  unit a = Environment (unit a :| [])
+mergeEnvs :: Environment l a -> Environment l a -> Environment l a
+mergeEnvs (Environment (a :| as)) (Environment (b :| bs)) =
+  Environment ((<>) a b :| alignWith (mergeThese (<>)) as bs)
 
--- | This instance is possibly unlawful. If this breaks, you get to keep both pieces.
-instance Monoid (Environment l a) where
-  mappend = (<>)
-  mempty  = Environment (mempty :| [])
+emptyEnv :: Environment l a
+emptyEnv = Environment (Empty.empty :| [])
 
 -- | Make and enter a new empty scope in the given environment.
 push :: Environment l a -> Environment l a
@@ -68,7 +68,7 @@ push (Environment (a :| as)) = Environment (mempty :| a : as)
 
 -- | Remove the frontmost scope.
 pop :: Environment l a -> Environment l a
-pop (Environment (_ :| []))     = mempty
+pop (Environment (_ :| []))     = Empty.empty
 pop (Environment (_ :| a : as)) = Environment (a :| as)
 
 -- | Drop all scopes save for the frontmost one.
@@ -92,6 +92,9 @@ mergeNewer (Environment a) (Environment b) =
 pairs :: Environment l a -> [(Name, Address l a)]
 pairs = Map.toList . fold . unEnvironment
 
+unpairs :: [(Name, Address l a)] -> Environment l a
+unpairs = fromList
+
 -- | Lookup a 'Name' in the environment.
 --
 -- >>> lookup (name "foo") shadowed
@@ -115,19 +118,19 @@ trim (Environment (a :| as)) = Environment (a :| filtered)
   where filtered = filter (not . Map.null) as
 
 bind :: Foldable t => t Name -> Environment l a -> Environment l a
-bind names env = foldMap envForName names
-  where envForName name = maybe mempty (curry unit name) (lookup name env)
+bind names env = fromList (mapMaybe lookupName (Prologue.toList names))
+  where
+    lookupName name = (,) name <$> lookup name env
 
 -- | Get all bound 'Name's in an environment.
 names :: Environment l a -> [Name]
 names = fmap fst . pairs
 
--- | Overwrite a set of key-value bindings in the provided environment.
+-- | Lookup and alias name-value bindings from an environment.
 overwrite :: [(Name, Name)] -> Environment l a -> Environment l a
-overwrite pairs env = foldMap go pairs where
-  go (k, v) = case lookup k env of
-    Nothing   -> mempty
-    Just addr -> unit (v, addr)
+overwrite pairs env = fromList $ mapMaybe lookupAndAlias pairs
+  where
+    lookupAndAlias (oldName, newName) = (,) newName <$> lookup oldName env
 
 -- | Retrieve the 'Live' set of addresses to which the given free variable names are bound.
 --

src/Data/Abstract/Evaluatable.hs

@@ -39,6 +39,7 @@ import           Data.Abstract.ModuleTable as ModuleTable
 import           Data.Abstract.Origin (SomeOrigin, packageOrigin)
 import           Data.Abstract.Package as Package
 import           Data.Language
+import           Data.Empty as Empty
 import           Data.Scientific (Scientific)
 import           Data.Semigroup.App
 import           Data.Semigroup.Foldable
@@ -220,12 +221,12 @@ load name = askModuleTable >>= maybeM notFound . ModuleTable.lookup name >>= eva
   where
     notFound = throwLoadError (LoadError name)
 
-    evalAndCache []     = (,) mempty <$> unit
+    evalAndCache []     = (,) Empty.empty <$> unit
     evalAndCache [x]    = evalAndCache' x
     evalAndCache (x:xs) = do
       (env, _) <- evalAndCache' x
       (env', v') <- evalAndCache xs
-      pure (env <> env', v')
+      pure (mergeEnvs env env', v')
 
     evalAndCache' x = do
       let mPath = modulePath (moduleInfo x)
@@ -233,7 +234,7 @@ load name = askModuleTable >>= maybeM notFound . ModuleTable.lookup name >>= eva
       if mPath `elem` unLoadStack
         then do -- Circular load, don't keep evaluating.
           v <- trace ("load (skip evaluating, circular load): " <> show mPath) unit
-          pure (mempty, v)
+          pure (Empty.empty, v)
         else do
           modifyLoadStack (loadStackPush mPath)
           v <- trace ("load (evaluating): " <> show mPath) $ evaluateModule x
@@ -249,7 +250,7 @@ load name = askModuleTable >>= maybeM notFound . ModuleTable.lookup name >>= eva
     filterEnv :: Exports.Exports l a -> Environment l a -> Environment l a
     filterEnv ports env
       | Exports.null ports = env
-      | otherwise = Exports.toEnvironment ports <> overwrite (Exports.aliases ports) env
+      | otherwise = Exports.toEnvironment ports `mergeEnvs` overwrite (Exports.aliases ports) env
 
 
 -- | Evaluate a term to a value using the semantics of the current analysis.

src/Data/Abstract/Exports.hs

@@ -10,10 +10,9 @@ module Data.Abstract.Exports
 import Prelude hiding (null)
 import Prologue hiding (null)
 import Data.Abstract.Address
-import Data.Abstract.Environment (Environment)
+import Data.Abstract.Environment (Environment, unpairs)
 import Data.Abstract.FreeVariables
 import qualified Data.Map as Map
-import Data.Semigroup.Reducer
 
 -- | A map of export names to an alias & address tuple.
 newtype Exports l a = Exports { unExports :: Map.Map Name (Name, Maybe (Address l a)) }
@@ -23,9 +22,10 @@ null :: Exports l a -> Bool
 null = Map.null . unExports
 
 toEnvironment :: Exports l a -> Environment l a
-toEnvironment = Map.foldMapWithKey buildEnv . unExports where
-  buildEnv _ (_, Nothing) = mempty
-  buildEnv _ (n, Just a)  = unit (n, a)
+toEnvironment exports = unpairs (mapMaybe collectExport (toList (unExports exports)))
+  where
+    collectExport (_, Nothing) = Nothing
+    collectExport (n, Just a)  = Just (n, a)
 
 insert :: Name -> Name -> Maybe (Address l a) -> Exports l a -> Exports l a
 insert name alias address = Exports . Map.insert name (alias, address) . unExports

src/Data/Abstract/Type.hs

@@ -10,6 +10,7 @@ import Control.Abstract.Analysis
 import Data.Abstract.Address
 import Data.Abstract.Environment as Env
 import Data.Align (alignWith)
+import qualified Data.Empty as Empty
 import Data.Semigroup.Reducer (Reducer)
 import Prelude
 import Prologue hiding (TypeError)
@@ -90,8 +91,8 @@ instance ( Alternative (m effects)
       tvar <- Var <$> raise fresh
       assign a tvar
       (env, tvars) <- rest
-      pure (Env.insert name a env, tvar : tvars)) (pure mempty) names
-    ret <- localEnv (mappend env) body
+      pure (Env.insert name a env, tvar : tvars)) (pure (Empty.empty, Empty.empty)) names
+    ret <- localEnv (mergeEnvs env) body
     pure (Product tvars :-> ret)
 
   unit       = pure Unit
@@ -111,7 +112,7 @@ instance ( Alternative (m effects)
   klass _ _ _   = pure Object
   namespace _ _ = pure Unit
 
-  scopedEnvironment _ = pure mempty
+  scopedEnvironment _ = pure Empty.empty
 
   asString t = unify t String $> ""
   asPair t   = do

src/Data/Abstract/Value.hs

@@ -230,12 +230,12 @@ instance ( Monad (m effects)
 
   klass n [] env = pure . injValue $ Class n env
   klass n supers env = do
-    product <- mconcat <$> traverse scopedEnvironment supers
-    pure . injValue $ Class n (Env.push product <> env)
+    product <- foldl mergeEnvs emptyEnv <$> traverse scopedEnvironment supers
+    pure . injValue $ Class n (mergeEnvs (Env.push product) env)
 
   namespace n env = do
     maybeAddr <- lookupEnv n
-    env' <- maybe (pure mempty) (asNamespaceEnv <=< deref) maybeAddr
+    env' <- maybe (pure emptyEnv) (asNamespaceEnv <=< deref) maybeAddr
     pure (injValue (Namespace n (Env.mergeNewer env' env)))
     where asNamespaceEnv v
             | Just (Namespace _ env') <- prjValue v = pure env'
@@ -338,7 +338,7 @@ instance ( Monad (m effects)
           a <- alloc name
           assign a v
           Env.insert name a <$> rest) (pure env) (zip names params)
-        localEnv (mappend bindings) (evalClosure label)
+        localEnv (mergeEnvs bindings) (evalClosure label)
       Nothing -> throwValueError (CallError op)
     where
       evalClosure :: Label -> m effects (Value location)

src/Data/Syntax/Expression.hs

@@ -195,7 +195,7 @@ instance Show1 MemberAccess where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable MemberAccess where
   eval (fmap subtermValue -> MemberAccess mem acc) = do
     lhs <- mem >>= scopedEnvironment
-    localEnv (mappend lhs) acc
+    localEnv (mergeEnvs lhs) acc
 
 -- | Subscript (e.g a[1])
 data Subscript a

src/Data/Syntax/Statement.hs

@@ -104,7 +104,7 @@ instance Evaluatable Assignment where
         modifyEnv (Env.insert name addr) $> v
       _ -> do
         lhs <- subtermValue assignmentTarget >>= scopedEnvironment
-        localEnv (mappend lhs) (subtermValue assignmentValue)
+        localEnv (mergeEnvs lhs) (subtermValue assignmentValue)
 
 -- | Post increment operator (e.g. 1++ in Go, or i++ in C).
 newtype PostIncrement a = PostIncrement a

src/Language/Go/Syntax.hs

@@ -60,7 +60,7 @@ instance Evaluatable Import where
     paths <- resolveGoImport importPath
     for_ paths $ \path -> do
       (importedEnv, _) <- traceResolve (unPath importPath) path $ isolate (require path)
-      modifyEnv (mappend importedEnv)
+      modifyEnv (mergeEnvs importedEnv)
     unit
 
 
@@ -81,9 +81,9 @@ instance Evaluatable QualifiedImport where
     void $ letrec' alias $ \addr -> do
       for_ paths $ \path -> do
         (importedEnv, _) <- traceResolve (unPath importPath) path $ isolate (require path)
-        modifyEnv (mappend importedEnv)
+        modifyEnv (mergeEnvs importedEnv)
 
-      makeNamespace alias addr []
+      makeNamespace alias addr Nothing
     unit
 
 -- | Side effect only imports (no symbols made available to the calling environment).

src/Language/PHP/Syntax.hs

@@ -50,7 +50,7 @@ include pathTerm f = do
   name <- subtermValue pathTerm >>= asString
   path <- resolvePHPName name
   (importedEnv, v) <- traceResolve name path $ isolate (f path)
-  modifyEnv (mappend importedEnv)
+  modifyEnv (mergeEnvs importedEnv)
   pure v
 
 newtype Require a = Require a
@@ -190,7 +190,7 @@ instance Show1 QualifiedName where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable QualifiedName where
   eval (fmap subtermValue -> QualifiedName name iden) = do
     lhs <- name >>= scopedEnvironment
-    localEnv (mappend lhs) iden
+    localEnv (mergeEnvs lhs) iden
 
 
 newtype NamespaceName a = NamespaceName (NonEmpty a)
@@ -205,7 +205,7 @@ instance Evaluatable NamespaceName where
     where
       f ns nam = do
         env <- ns >>= scopedEnvironment
-        localEnv (mappend env) nam
+        localEnv (mergeEnvs env) nam
 
 newtype ConstDeclaration a = ConstDeclaration [a]
   deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)
@@ -366,10 +366,10 @@ instance Evaluatable Namespace where
       go [] = raise (fail "expected at least one free variable in namespaceName, found none")
       -- The last name creates a closure over the namespace body.
       go [name] = letrec' name $ \addr ->
-        subtermValue namespaceBody *> makeNamespace name addr []
+        subtermValue namespaceBody *> makeNamespace name addr Nothing
       -- Each namespace name creates a closure over the subsequent namespace closures
       go (name:xs) = letrec' name $ \addr ->
-        go xs <* makeNamespace name addr []
+        go xs <* makeNamespace name addr Nothing
 
 data TraitDeclaration a = TraitDeclaration { traitName :: a, traitStatements :: [a] }
   deriving (Diffable, Eq, Foldable, Functor, FreeVariables1, Declarations1, GAlign, Generic1, Mergeable, Ord, Show, Traversable)

src/Language/Python/Syntax.hs

@@ -101,7 +101,7 @@ instance Evaluatable Import where
     -- Last module path is the one we want to import
     let path = NonEmpty.last modulePaths
     (importedEnv, _) <- isolate (require path)
-    modifyEnv (mappend (select importedEnv))
+    modifyEnv (mergeEnvs (select importedEnv))
     unit
     where
       select importedEnv
@@ -126,14 +126,14 @@ instance Evaluatable QualifiedImport where
       -- Evaluate and import the last module, updating the environment
       go ((name, path) :| []) = letrec' name $ \addr -> do
         (importedEnv, _) <- isolate (require path)
-        modifyEnv (mappend importedEnv)
-        void $ makeNamespace name addr []
+        modifyEnv (mergeEnvs importedEnv)
+        void $ makeNamespace name addr Nothing
         unit
       -- Evaluate each parent module, creating a just namespace
       go ((name, path) :| xs) = letrec' name $ \addr -> do
         void $ isolate (require path)
         void $ go (NonEmpty.fromList xs)
-        makeNamespace name addr []
+        makeNamespace name addr Nothing
 
 data QualifiedAliasedImport a = QualifiedAliasedImport { qualifiedAliasedImportFrom :: QualifiedName, qualifiedAliasedImportAlias :: !a }
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
@@ -155,8 +155,8 @@ instance Evaluatable QualifiedAliasedImport where
     letrec' alias $ \addr -> do
       let path = NonEmpty.last modulePaths
       (importedEnv, _) <- isolate (require path)
-      modifyEnv (mappend importedEnv)
-      void $ makeNamespace alias addr []
+      modifyEnv (mergeEnvs importedEnv)
+      void $ makeNamespace alias addr Nothing
       unit
 
 -- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell)

src/Language/Ruby/Assignment.hs

@@ -218,11 +218,13 @@ endBlock :: Assignment
 endBlock = makeTerm <$> symbol EndBlock <*> children (Statement.ScopeExit <$> many expression)
 
 class' :: Assignment
-class' = makeTerm <$> symbol Class <*> (withNewScope . children) (Ruby.Syntax.Class <$> expression <*> (superclass <|> pure []) <*> expressions)
-  where superclass = pure <$ symbol Superclass <*> children expression
+class' = makeTerm <$> symbol Class <*> (withNewScope . children) (Ruby.Syntax.Class <$> expression <*> optional superclass <*> expressions)
+  where
+    superclass :: Assignment
+    superclass = symbol Superclass *> children expression
 
 singletonClass :: Assignment
-singletonClass = makeTerm <$> symbol SingletonClass <*> (withNewScope . children) (Ruby.Syntax.Class <$> expression <*> pure [] <*> expressions)
+singletonClass = makeTerm <$> symbol SingletonClass <*> (withNewScope . children) (Ruby.Syntax.Class <$> expression <*> pure Nothing <*> expressions)
 
 module' :: Assignment
 module' = makeTerm <$> symbol Module <*> (withNewScope . children) (Ruby.Syntax.Module <$> expression <*> many expression)

src/Language/Ruby/Syntax.hs

@@ -50,7 +50,7 @@ instance Evaluatable Send where
     func <- case sendReceiver of
       Just recv -> do
         recvEnv <- subtermValue recv >>= scopedEnvironment
-        localEnv (mappend recvEnv) sel
+        localEnv (mergeEnvs recvEnv) sel
       Nothing -> sel -- TODO Does this require `localize` so we don't leak terms when resolving `sendSelector`?
 
     call func (map subtermValue sendArgs) -- TODO pass through sendBlock
@@ -101,13 +101,12 @@ doLoad :: MonadEvaluatable location term value effects m => ByteString -> Bool -
 doLoad path shouldWrap = do
   path' <- resolveRubyPath path
   (importedEnv, _) <- traceResolve path path' $ isolate (load path')
-  unless shouldWrap $ modifyEnv (mappend importedEnv)
+  unless shouldWrap $ modifyEnv (mergeEnvs importedEnv)
   boolean Prelude.True -- load always returns true. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-load
 
 -- TODO: autoload
 
-
-data Class a = Class { classIdentifier :: !a, classSuperClasses :: ![a], classBody :: !a }
+data Class a = Class { classIdentifier :: !a, classSuperClass :: !(Maybe a), classBody :: !a }
   deriving (Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
 
 instance Diffable Class where
@@ -119,10 +118,10 @@ instance Show1 Class where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Class where
   eval Class{..} = do
-    supers <- traverse subtermValue classSuperClasses
+    super <- traverse subtermValue classSuperClass
     name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm classIdentifier)
     letrec' name $ \addr ->
-      subtermValue classBody <* makeNamespace name addr supers
+      subtermValue classBody <* makeNamespace name addr super
 
 data Module a = Module { moduleIdentifier :: !a, moduleStatements :: ![a] }
   deriving (Diffable, Eq, Foldable, Functor, GAlign, Generic1, Mergeable, Ord, Show, Traversable, FreeVariables1, Declarations1)
@@ -135,7 +134,7 @@ instance Evaluatable Module where
   eval (Module iden xs) = do
     name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm iden)
     letrec' name $ \addr ->
-      eval xs <* makeNamespace name addr []
+      eval xs <* makeNamespace name addr Nothing
 
 data LowPrecedenceBoolean a
   = LowAnd !a !a

src/Language/TypeScript/Syntax.hs

@@ -95,8 +95,8 @@ javascriptExtensions = ["js"]
 evalRequire :: MonadEvaluatable location term value effects m => ModulePath -> Name -> m effects value
 evalRequire modulePath alias = letrec' alias $ \addr -> do
   (importedEnv, _) <- isolate (require modulePath)
-  modifyEnv (mappend importedEnv)
-  void $ makeNamespace alias addr []
+  modifyEnv (mergeEnvs importedEnv)
+  void $ makeNamespace alias addr Nothing
   unit
 
 data Import a = Import { importSymbols :: ![(Name, Name)], importFrom :: ImportPath }
@@ -111,7 +111,7 @@ instance Evaluatable Import where
   eval (Import symbols importPath) = do
     modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions
     (importedEnv, _) <- isolate (require modulePath)
-    modifyEnv (mappend (renamed importedEnv)) *> unit
+    modifyEnv (mergeEnvs (renamed importedEnv)) *> unit
     where
       renamed importedEnv
         | Prologue.null symbols = importedEnv
@@ -609,7 +609,7 @@ instance Evaluatable Module where
   eval (Module iden xs) = do
     name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm iden)
     letrec' name $ \addr ->
-      eval xs <* makeNamespace name addr []
+      eval xs <* makeNamespace name addr Nothing
 
 
 
@@ -624,7 +624,7 @@ instance Evaluatable InternalModule where
   eval (InternalModule iden xs) = do
     name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm iden)
     letrec' name $ \addr ->
-      eval xs <* makeNamespace name addr []
+      eval xs <* makeNamespace name addr Nothing
 
 instance Declarations a => Declarations (InternalModule a) where
   declaredName InternalModule{..} = declaredName internalModuleIdentifier

test/Analysis/TypeScript/Spec.hs

@@ -30,7 +30,7 @@ spec = parallel $ do
 
     it "side effect only imports" $ do
       env <- environment . snd <$> evaluate "main2.ts"
-      env `shouldBe` mempty
+      env `shouldBe` emptyEnv
 
     it "fails exporting symbols not defined in the module" $ do
       v <- fst <$> evaluate "bad-export.ts"