Copy my changes back.

semantic.cabal

@@ -161,6 +161,7 @@ library
                      , recursion-schemes
                      , reducers
                      , scientific
+                     , semigroupoids
                      , split
                      , stm-chans
                      , template-haskell

src/Analysis/Abstract/Evaluating.hs

@@ -26,28 +26,30 @@ import Prologue
 import System.FilePath.Posix
 
 -- | Evaluate a term to a value.
-evaluate :: forall value term
-         .  ( Evaluatable (Base term)
+evaluate :: forall value term effects
+         .  ( effects ~ RequiredEffects term value (Evaluating term value effects)
+            , Evaluatable (Base term)
             , FreeVariables term
-            , MonadAddressable (LocationFor value) value (Evaluating term value (EvaluatingEffects term value))
-            , MonadValue term value (Evaluating term value (EvaluatingEffects term value))
+            , MonadAddressable (LocationFor value) value (Evaluating term value effects)
+            , MonadValue term value (Evaluating term value effects)
             , Recursive term
             )
          => term
-         -> Final (EvaluatingEffects term value) value
+         -> Final effects value
 evaluate = runAnalysis @(Evaluating term value) . evaluateModule
 
 -- | Evaluate terms and an entry point to a value.
-evaluates :: forall value term
-          .  ( Evaluatable (Base term)
+evaluates :: forall value term effects
+          .  ( effects ~ RequiredEffects term value (Evaluating term value effects)
+             , Evaluatable (Base term)
              , FreeVariables term
-             , MonadAddressable (LocationFor value) value (Evaluating term value (EvaluatingEffects term value))
-             , MonadValue term value (Evaluating term value (EvaluatingEffects term value))
+             , MonadAddressable (LocationFor value) value (Evaluating term value effects)
+             , MonadValue term value (Evaluating term value effects)
              , Recursive term
              )
           => [(Blob, term)] -- List of (blob, term) pairs that make up the program to be evaluated
           -> (Blob, term)   -- Entrypoint
-          -> Final (EvaluatingEffects term value) value
+          -> Final effects value
 evaluates pairs (b, t) = runAnalysis @(Evaluating term value) (withModules b pairs (evaluateModule t))
 
 -- | Run an action with the passed ('Blob', @term@) pairs available for imports.

src/Control/Abstract/Analysis.hs

@@ -2,6 +2,8 @@
 module Control.Abstract.Analysis
 ( MonadAnalysis(..)
 , evaluateTerm
+, require
+, load
 , liftAnalyze
 , runAnalysis
 , module X
@@ -17,7 +19,12 @@ import Control.Monad.Effect.Fresh as X
 import Control.Monad.Effect.NonDet as X
 import Control.Monad.Effect.Reader as X
 import Control.Monad.Effect.State as X
+import Data.Abstract.Environment
+import Data.Abstract.ModuleTable
+import Data.Abstract.Value
 import Data.Coerce
+import qualified Data.Map as Map
+import Prelude hiding (fail)
 import Prologue
 
 -- | A 'Monad' in which one can evaluate some specific term type to some specific value type.
@@ -41,6 +48,38 @@ evaluateTerm :: MonadAnalysis term value m => term -> m value
 evaluateTerm = foldSubterms analyzeTerm
 
 
+-- | Require/import another term/file and return an Effect.
+--
+-- Looks up the term's name in the cache of evaluated modules first, returns a value if found, otherwise loads/evaluates the module.
+require :: ( MonadAnalysis term value m
+           , Ord (LocationFor value)
+           )
+        => ModuleName
+        -> m (EnvironmentFor value)
+require name = getModuleTable >>= maybe (load name) pure . moduleTableLookup name
+
+-- | Load another term/file and return an Effect.
+--
+-- Always loads/evaluates.
+load :: ( MonadAnalysis term value m
+        , Ord (LocationFor value)
+        )
+     => ModuleName
+     -> m (EnvironmentFor value)
+load name = askModuleTable >>= maybe notFound evalAndCache . moduleTableLookup name
+  where notFound = fail ("cannot load module: " <> show name)
+        evalAndCache e = do
+          void $ evaluateModule e
+          -- TODO: If the set of exports is empty because no exports have been
+          -- defined, do we export all terms, or no terms? This behavior varies across
+          -- languages. We need better semantics rather than doing it ad-hoc.
+          env <- getGlobalEnv
+          exports <- getExports
+          let env' = if Map.null exports then env else bindExports exports env
+          modifyModuleTable (moduleTableInsert name env')
+          pure env'
+
+
 -- | 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.
 liftAnalyze :: ( Coercible (  m term value (effects :: [* -> *]) value) (t m term value effects value)
                , Coercible (t m term value effects value) (  m term value effects value)

src/Control/Abstract/Evaluator.hs

@@ -13,7 +13,6 @@ module Control.Abstract.Evaluator
 import Data.Abstract.Address
 import Data.Abstract.Configuration
 import Data.Abstract.FreeVariables
-import Data.Abstract.Live
 import Data.Abstract.ModuleTable
 import Data.Abstract.Store
 import Data.Abstract.Value

src/Control/Abstract/Value.hs

@@ -7,7 +7,6 @@ import Data.Abstract.Environment
 import Data.Abstract.FreeVariables
 import Data.Abstract.Type as Type
 import Data.Abstract.Value as Value
-import qualified Data.Map as Map
 import Data.Scientific (Scientific, fromFloatDigits, toRealFloat)
 import Prelude hiding (fail)
 import Prologue
@@ -60,9 +59,6 @@ class (MonadAnalysis term value m, Show value) => MonadValue term value m where
   -- | Construct an N-ary tuple of multiple (possibly-disjoint) values
   multiple :: [value] -> m value
 
-  -- | Construct an abstract interface value.
-  interface :: value -> m value
-
   -- | Eliminate boolean values. TODO: s/boolean/truthy
   ifthenelse :: value -> m a -> m a -> m a
 
@@ -71,9 +67,6 @@ class (MonadAnalysis term value m, Show value) => MonadValue term value m where
   -- | Evaluate an application (like a function call).
   apply :: value -> [Subterm term (m value)] -> m value
 
-  -- | Extract the environment from an interface value.
-  environment :: value -> m (EnvironmentFor value)
-
 -- | Attempt to extract a 'Prelude.Bool' from a given value.
 toBool :: MonadValue term value m => value -> m Bool
 toBool v = ifthenelse v (pure True) (pure False)
@@ -123,15 +116,6 @@ instance ( MonadAddressable location (Value location term) m
   multiple vals =
     pure . injValue $ Value.Tuple vals
 
-  interface v = do
-    -- TODO: If the set of exports is empty because no exports have been
-    -- defined, do we export all terms, or no terms? This behavior varies across
-    -- languages. We need better semantics rather than doing it ad-hoc.
-    env <- getGlobalEnv
-    exports <- getExports
-    let env' = if Map.null exports then env else bindExports exports env
-    pure (injValue (Value.Interface v env'))
-
   ifthenelse cond if' else'
     | Just (Boolean b) <- prjValue cond = if b then if' else else'
     | otherwise = fail ("not defined for non-boolean conditions: " <> show cond)
@@ -190,10 +174,6 @@ instance ( MonadAddressable location (Value location term) m
       envInsert name a <$> rest) (pure env) (zip names params)
     localEnv (mappend bindings) (evaluateTerm body)
 
-  environment v
-    | Just (Interface _ env) <- prjValue v = pure env
-    | otherwise                            = pure mempty
-
 -- | Discard the value arguments (if any), constructing a 'Type.Type' instead.
 instance (Alternative m, MonadAnalysis term Type m, MonadFresh m) => MonadValue term Type m where
   abstract names (Subterm _ body) = do
@@ -212,8 +192,6 @@ instance (Alternative m, MonadAnalysis term Type m, MonadFresh m) => MonadValue
   string _  = pure Type.String
   float _   = pure Type.Float
   multiple  = pure . Type.Product
-  -- TODO
-  interface = undefined
 
   ifthenelse cond if' else' = unify cond Bool *> (if' <|> else')
 
@@ -233,6 +211,3 @@ instance (Alternative m, MonadAnalysis term Type m, MonadFresh m) => MonadValue
     paramTypes <- traverse subtermValue params
     _ :-> ret <- op `unify` (Product paramTypes :-> Var tvar)
     pure ret
-
-  -- TODO
-  environment = undefined

src/Data/Abstract/Environment.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, StandaloneDeriving #-}
 module Data.Abstract.Environment where
 
 import Prologue
@@ -6,12 +6,15 @@ import Data.Abstract.Address
 import Data.Abstract.FreeVariables
 import Data.Abstract.Live
 import qualified Data.Map as Map
+import Data.Semigroup.Reducer
 import qualified Data.Set as Set
 
 -- | A map of names to addresses that represents the evaluation environment.
 newtype Environment l a = Environment { unEnvironment :: Map.Map Name (Address l a) }
   deriving (Eq, Foldable, Functor, Generic1, Monoid, Ord, Semigroup, Show, Traversable)
 
+deriving instance Reducer (Name, Address l a) (Environment l a)
+
 -- | Lookup a 'Name' in the environment.
 envLookup :: Name -> Environment l a -> Maybe (Address l a)
 envLookup k = Map.lookup k . unEnvironment
@@ -20,9 +23,6 @@ envLookup k = Map.lookup k . unEnvironment
 envInsert :: Name -> Address l a -> Environment l a -> Environment l a
 envInsert name value (Environment m) = Environment (Map.insert name value m)
 
-envUnion :: Environment l a -> Environment l a -> Environment l a
-envUnion (Environment e1) (Environment e2) = Environment $ Map.union e1 e2
-
 bindEnv :: (Ord l, Foldable t) => t Name -> Environment l a -> Environment l a
 bindEnv names env = foldMap envForName names
   where envForName name = maybe mempty (curry unit name) (envLookup name env)

src/Data/Abstract/Evaluatable.hs

@@ -6,20 +6,16 @@ module Data.Abstract.Evaluatable
 , module FreeVariables
 , module Value
 , MonadEvaluator(..)
-, require
-, load
 ) where
 
 import Control.Abstract.Addressable as Addressable
 import Control.Abstract.Analysis as Analysis
 import Control.Abstract.Value as Value
-import Data.Abstract.Environment
 import Data.Abstract.FreeVariables as FreeVariables
-import Data.Abstract.ModuleTable
 import Data.Abstract.Value
 import Data.Functor.Classes
 import Data.Proxy
-import Data.Semigroup
+import Data.Semigroup.Foldable
 import Data.Term
 import Prelude hiding (fail)
 import Prologue
@@ -42,7 +38,7 @@ instance Apply Evaluatable fs => Evaluatable (Union fs) where
 
 -- | Evaluating a 'TermF' ignores its annotation, evaluating the underlying syntax.
 instance Evaluatable s => Evaluatable (TermF s a) where
-  eval In{..} = eval termFOut
+  eval = eval . termFOut
 
 
 -- Instances
@@ -53,42 +49,17 @@ instance Evaluatable s => Evaluatable (TermF s a) where
 --   2. Each statement can affect the environment of later statements (e.g. by 'modify'-ing the environment); and
 --   3. Only the last statement’s return value is returned.
 instance Evaluatable [] where
-  eval []     = unit           -- Return unit value if this is an empty list of terms
-  eval [x]    = subtermValue x -- Return the value for the last term
-  eval (x:xs) = do
-    _ <- subtermValue x        -- Evaluate the head term
-    env <- getGlobalEnv        -- Get the global environment after evaluation
-                               -- since it might have been modified by the
-                               -- evaluation above ^.
+  -- 'nonEmpty' and 'foldMap1' enable us to return the last statement’s result instead of 'unit' for non-empty lists.
+  eval = maybe unit (runImperative . foldMap1 (Imperative . subtermValue)) . nonEmpty
 
-    -- Finally, evaluate the rest of the terms, but do so by calculating a new
-    -- environment each time where the free variables in those terms are bound
-    -- to the global environment.
-    localEnv (const (bindEnv (liftFreeVariables (freeVariables . subterm) xs) env)) (eval xs)
+-- | A 'Semigroup' providing an imperative context which extends the local environment with new bindings.
+newtype Imperative m a = Imperative { runImperative :: m a }
 
+instance MonadEnvironment value m => Semigroup (Imperative m a) where
+  Imperative a <> Imperative b = Imperative $ a *> do
+    env <- getGlobalEnv
+    localEnv (<> env) b
 
--- | Require/import another term/file and return an Effect.
---
--- Looks up the term's name in the cache of evaluated modules first, returns a value if found, otherwise loads/evaluates the module.
-require :: ( MonadAnalysis term value m
-           , MonadValue term value m
-           )
-        => ModuleName
-        -> m (EnvironmentFor value)
-require name = getModuleTable >>= maybe (load name) pure . moduleTableLookup name
-
--- | Load another term/file and return an Effect.
---
--- Always loads/evaluates.
-load :: ( MonadAnalysis term value m
-        , MonadValue term value m
-        )
-     => ModuleName
-     -> m (EnvironmentFor value)
-load name = askModuleTable >>= maybe notFound evalAndCache . moduleTableLookup name
-  where notFound = fail ("cannot load module: " <> show name)
-        evalAndCache e = do
-          v <- evaluateModule e
-          env <- environment v
-          modifyModuleTable (moduleTableInsert name env)
-          pure env
+instance MonadValue term value m => Monoid (Imperative m value) where
+  mempty = Imperative unit
+  mappend = (<>)

src/Data/Syntax/Declaration.hs

@@ -5,8 +5,6 @@ import Data.Abstract.Environment
 import Data.Abstract.Evaluatable
 import Diffing.Algorithm
 import qualified Data.Map as Map
-import qualified Data.ByteString as B
-import qualified Data.List.NonEmpty as NonEmpty
 import Prologue
 
 data Function a = Function { functionContext :: ![a], functionName :: !a, functionParameters :: ![a], functionBody :: !a }

src/Language/TypeScript/Assignment.hs

@@ -7,15 +7,13 @@ module Language.TypeScript.Assignment
 ) where
 
 import Assigning.Assignment hiding (Assignment, Error)
+import qualified Assigning.Assignment as Assignment
 import Data.Abstract.FreeVariables
+import qualified Data.ByteString as B (filter)
+import qualified Data.ByteString.Char8 as BC
+import Data.Char (ord)
 import Data.Record
 import Data.Syntax (emptyTerm, handleError, parseError, infixContext, makeTerm, makeTerm', makeTerm'', makeTerm1, contextualize, postContextualize)
-import Language.TypeScript.Grammar as Grammar
-import Prologue
-import qualified Data.ByteString.Char8 as BC
-import qualified Data.ByteString as B
-import Data.Char (ord)
-import qualified Assigning.Assignment as Assignment
 import qualified Data.Syntax as Syntax
 import qualified Data.Syntax.Comment as Comment
 import qualified Data.Syntax.Declaration as Declaration
@@ -24,9 +22,9 @@ import qualified Data.Syntax.Literal as Literal
 import qualified Data.Syntax.Statement as Statement
 import qualified Data.Syntax.Type as Type
 import qualified Data.Term as Term
-import qualified Data.ByteString as B (filter)
-import Data.Char (ord)
+import Language.TypeScript.Grammar as Grammar
 import qualified Language.TypeScript.Syntax as TypeScript.Syntax
+import Prologue
 
 -- | The type of TypeScript syntax.
 type Syntax = '[