Merge pull request #1699 from github/package-abstraction

Package abstraction

semantic.cabal

@@ -59,6 +59,7 @@ library
                      , Data.Abstract.ModuleTable
                      , Data.Abstract.Number
                      , Data.Abstract.Origin
+                     , Data.Abstract.Package
                      , Data.Abstract.Path
                      , Data.Abstract.Type
                      , Data.Abstract.Value

src/Analysis/Abstract/Collecting.hs

@@ -25,8 +25,6 @@ instance ( Effectful m
       => MonadEvaluator location term value (Collecting m effects) where
   getConfiguration term = Configuration term <$> askRoots <*> getEnv <*> getHeap
 
-  askModuleStack = Collecting askModuleStack
-
 
 instance ( Effectful m
          , Foldable (Cell location)

src/Analysis/Abstract/Evaluating.hs

@@ -37,8 +37,7 @@ type EvaluatingEffects location term value
      , Resumable (Unspecialized value)
      , Fail                                         -- Failure with an error message
      , Fresh                                        -- For allocating new addresses and/or type variables.
-     , Reader [Module term]                         -- The stack of currently-evaluating modules.
+     , Reader (SomeOrigin term)                     -- The current term’s origin.
-     , Reader Origin                                -- The current term’s origin.
      , Reader (ModuleTable [Module term])           -- Cache of unevaluated modules
      , Reader (Environment location value)          -- Default environment used as a fallback in lookupEnv
      , State  (EvaluatingState location term value) -- Environment, heap, modules, exports, and jumps.
@@ -139,23 +138,14 @@ instance Members (EvaluatingEffects location term value) effects
       => MonadEvaluator location term value (Evaluating location term value effects) where
   getConfiguration term = Configuration term mempty <$> getEnv <*> getHeap
 
-  askModuleStack = raise ask
+instance ( Corecursive term
-
+         , Members (EvaluatingEffects location term value) effects
-instance ( Members (EvaluatingEffects location term value) effects
          , MonadValue location value (Evaluating location term value effects)
-         , HasOrigin (Base term)
+         , Recursive term
          )
       => MonadAnalysis location term value (Evaluating location term value effects) where
   type Effects location term value (Evaluating location term value effects) = EvaluatingEffects location term value
 
-  analyzeTerm eval term = do
+  analyzeTerm eval term = pushOrigin (termOrigin (embedSubterm term)) (eval term)
-    ms <- askModuleStack
-    pushOrigin (originFor ms term) (eval term)
 
-  analyzeModule eval m = pushModule (subterm <$> m) (eval m)
+  analyzeModule eval m = pushOrigin (moduleOrigin (subterm <$> m)) (eval m)
-
-pushModule :: Member (Reader [Module term]) effects => Module term -> Evaluating location term value effects a -> Evaluating location term value effects a
-pushModule m = raise . local (m :) . lower
-
-pushOrigin :: Member (Reader Origin) effects => Origin -> Evaluating location term value effects a -> Evaluating location term value effects a
-pushOrigin o = raise . local (const o) . lower

src/Analysis/Abstract/ImportGraph.hs

@@ -13,6 +13,7 @@ import           Control.Abstract.Analysis
 import           Data.Abstract.Evaluatable (LoadError (..))
 import           Data.Abstract.FreeVariables
 import           Data.Abstract.Module
+import           Data.Abstract.Origin
 import           Prologue hiding (empty)
 
 -- | The graph of function definitions to symbols used in a given program.
@@ -34,6 +35,7 @@ deriving instance MonadEvaluator location term value (m effects)   => MonadEvalu
 
 
 instance ( Effectful m
+         , Member (Reader (SomeOrigin term)) effects
          , Member (State ImportGraph) effects
          , MonadAnalysis location term value (m effects)
          , Member (Resumable (LoadError term value)) effects
@@ -47,17 +49,20 @@ instance ( Effectful m
                             (\yield (LoadError name) -> insertVertexName name >> yield [])
 
   analyzeModule recur m = do
-    insertVertexName (moduleName m)
+    insertVertexName (moduleName (moduleInfo m))
     liftAnalyze analyzeModule recur m
 
-insertVertexName :: (Effectful m
+insertVertexName :: forall m location term value effects
-                   , Member (State ImportGraph) effects
+                 .  ( Effectful m
-                   , MonadEvaluator location term value (m effects))
+                    , Member (Reader (SomeOrigin term)) effects
+                    , Member (State ImportGraph) effects
+                    , MonadEvaluator location term value (m effects)
+                    )
                  => NonEmpty ByteString
                  -> ImportGraphing m effects ()
 insertVertexName name = do
-    ms <- askModuleStack
+    o <- raise ask
-    let parent = maybe empty (vertex . moduleName) (listToMaybe ms)
+    let parent = maybe empty (vertex . moduleName) (withSomeOrigin (originModule @term) o)
     modifyImportGraph (parent >< vertex name <>)
 
 (><) :: Graph a => a -> a -> a

src/Control/Abstract/Evaluator.hs

@@ -46,11 +46,6 @@ class ( MonadControl term m
   -- | Get the current 'Configuration' with a passed-in term.
   getConfiguration :: Ord location => term -> m (Configuration location term value)
 
-  -- | Retrieve the stack of modules currently being evaluated.
-  --
-  --   With great power comes great responsibility. If you 'evaluateModule' any of these, you probably deserve what you get.
-  askModuleStack :: m [Module term]
-
 
 -- | A 'Monad' abstracting local and global environments.
 class Monad m => MonadEnvironment location value m | m -> value, m -> location where

src/Control/Abstract/Value.hs

@@ -124,9 +124,9 @@ class (Monad m, Show value) => MonadValue location value m | m value -> location
   scopedEnvironment :: value -> m (Environment location value)
 
   -- | Evaluate an abstraction (a binder like a lambda or method definition).
-  abstract :: (FreeVariables term, MonadControl term m) => [Name] -> Subterm term (m value) -> m value
+  lambda :: (FreeVariables term, MonadControl term m) => [Name] -> Subterm term (m value) -> m value
   -- | Evaluate an application (like a function call).
-  apply :: value -> [m value] -> m value
+  call :: value -> [m value] -> m value
 
   -- | Primitive looping combinator, approximately equivalent to 'fix'. This should be used in place of direct recursion, as it allows abstraction over recursion.
   --

src/Data/Abstract/Evaluatable.hs

@@ -6,13 +6,15 @@ module Data.Abstract.Evaluatable
 , Unspecialized(..)
 , LoadError(..)
 , EvalError(..)
+, variable
 , evaluateTerm
 , evaluateModule
-, withModules
 , evaluateModules
+, evaluatePackage
 , throwLoadError
 , require
 , load
+, pushOrigin
 ) where
 
 import           Control.Abstract.Addressable as X
@@ -23,11 +25,12 @@ import qualified Data.Abstract.Exports as Exports
 import           Data.Abstract.FreeVariables as X
 import           Data.Abstract.Module
 import           Data.Abstract.ModuleTable as ModuleTable
+import           Data.Abstract.Origin (SomeOrigin, packageOrigin)
+import           Data.Abstract.Package as Package
 import           Data.Semigroup.App
 import           Data.Semigroup.Foldable
 import           Data.Semigroup.Reducer hiding (unit)
 import           Data.Term
-import           Prelude hiding (fail)
 import           Prologue
 
 type MonadEvaluatable location term value m =
@@ -62,6 +65,10 @@ data EvalError value resume where
   -- Indicates we weren't able to dereference a name from the evaluated environment.
   FreeVariableError :: Name -> EvalError value value
 
+-- | Look up and dereference the given 'Name', throwing an exception for free variables.
+variable :: MonadEvaluatable location term value m => Name -> m value
+variable name = lookupWith deref name >>= maybeM (throwException (FreeVariableError name))
+
 deriving instance Eq (EvalError a b)
 deriving instance Show (EvalError a b)
 instance Show1 (EvalError value) where
@@ -116,7 +123,7 @@ instance Evaluatable [] where
 require :: MonadEvaluatable location term value m
         => ModuleName
         -> m (Environment location value, value)
-require name = getModuleTable >>= maybe (load name) pure . moduleTableLookup name
+require name = getModuleTable >>= maybeM (load name) . ModuleTable.lookup name
 
 -- | Load another module by name and return it's environment and value.
 --
@@ -124,11 +131,11 @@ require name = getModuleTable >>= maybe (load name) pure . moduleTableLookup nam
 load :: MonadEvaluatable location term value m
      => ModuleName
      -> m (Environment location value, value)
-load name = askModuleTable >>= maybe notFound pure . moduleTableLookup name >>= evalAndCache
+load name = askModuleTable >>= maybeM notFound . ModuleTable.lookup name >>= evalAndCache
   where
     notFound = throwLoadError (LoadError name)
 
-    evalAndCache []     = (,) <$> pure mempty <*> unit
+    evalAndCache []     = (,) mempty <$> unit
     evalAndCache [x]    = evalAndCache' x
     evalAndCache (x:xs) = do
       (env, _) <- evalAndCache' x
@@ -138,7 +145,7 @@ load name = askModuleTable >>= maybe notFound pure . moduleTableLookup name >>=
     evalAndCache' x = do
       v <- evaluateModule x
       env <- filterEnv <$> getExports <*> getEnv
-      modifyModuleTable (moduleTableInsert name (env, v))
+      modifyModuleTable (ModuleTable.insert name (env, v))
       pure (env, v)
 
     -- TODO: If the set of exports is empty because no exports have been
@@ -164,17 +171,36 @@ evaluateModule :: MonadEvaluatable location term value m
                -> m value
 evaluateModule m = analyzeModule (subtermValue . moduleBody) (fmap (Subterm <*> evaluateTerm) m)
 
-
--- | Run an action with the a list of 'Module's available for imports.
-withModules :: MonadEvaluatable location term value m
-            => [Module term]
-            -> m a
-            -> m a
-withModules = localModuleTable . const . ModuleTable.fromList
-
 -- | Evaluate with a list of modules in scope, taking the head module as the entry point.
 evaluateModules :: MonadEvaluatable location term value m
                 => [Module term]
                 -> m value
-evaluateModules []     = fail "evaluateModules: empty list"
+evaluateModules = fmap Prelude.head . evaluatePackageBody . Package.fromModules
-evaluateModules (m:ms) = withModules ms (evaluateModule m)
+
+-- | Evaluate a given package.
+evaluatePackage :: ( Effectful m
+                   , Member (Reader (SomeOrigin term)) effects
+                   , MonadEvaluatable location term value (m effects)
+                   )
+                => Package term
+                -> m effects [value]
+evaluatePackage p = pushOrigin (packageOrigin p) (evaluatePackageBody (packageBody p))
+
+-- | Evaluate a given package body (module table and entry points).
+evaluatePackageBody :: MonadEvaluatable location term value m
+                    => PackageBody term
+                    -> m [value]
+evaluatePackageBody body = localModuleTable (<> packageModules body)
+  (traverse evaluateEntryPoint (ModuleTable.toPairs (packageEntryPoints body)))
+  where evaluateEntryPoint (m, sym) = do
+          (_, v) <- require m
+          maybe (pure v) ((`call` []) <=< variable) sym
+
+-- | Push a 'SomeOrigin' onto the stack. This should be used to contextualize execution with information about the originating term, module, or package.
+pushOrigin :: ( Effectful m
+              , Member (Reader (SomeOrigin term)) effects
+              )
+           => SomeOrigin term
+           -> m effects a
+           -> m effects a
+pushOrigin o = raise . local (<> o) . lower

src/Data/Abstract/Located.hs

@@ -1,17 +1,28 @@
-{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE TypeFamilies, UndecidableInstances #-}
 module Data.Abstract.Located where
 
 import Control.Abstract.Addressable
+import Control.Effect
+import Control.Monad.Effect.Reader
 import Data.Abstract.Address
 import Data.Abstract.Origin
+import Prologue
 
-data Located location = Located { location :: location, origin :: !Origin }
+data Located location term = Located { location :: location, origin :: !(SomeOrigin term) }
-  deriving (Eq, Ord, Show)
 
-instance Location location => Location (Located location) where
+deriving instance (Eq location, Eq (Base term ())) => Eq (Located location term)
-  type Cell (Located location) = Cell location
+deriving instance (Ord location, Ord (Base term ())) => Ord (Located location term)
+deriving instance (Show location, Show (Base term ())) => Show (Located location term)
 
-instance (MonadAddressable location m, MonadOrigin m) => MonadAddressable (Located location) m where
+instance (Location location, Ord (Base term ())) => Location (Located location term) where
+  type Cell (Located location term) = Cell location
+
+instance ( Effectful m
+         , Member (Reader (SomeOrigin term)) effects
+         , MonadAddressable location (m effects)
+         , Ord (Base term ())
+         )
+      => MonadAddressable (Located location term) (m effects) where
   derefCell (Address (Located loc _)) = derefCell (Address loc)
 
-  allocLoc name = Located <$> allocLoc name <*> askOrigin
+  allocLoc name = Located <$> allocLoc name <*> raise ask

src/Data/Abstract/Module.hs

@@ -1,5 +1,6 @@
 module Data.Abstract.Module
 ( Module(..)
+, ModuleInfo(..)
 , ModuleName
 , moduleForBlob
 ) where
@@ -13,7 +14,10 @@ import System.FilePath.Posix
 
 type ModuleName = Name
 
-data Module term = Module { moduleName :: ModuleName, modulePath :: FilePath, moduleBody :: term }
+data ModuleInfo = ModuleInfo { moduleName :: ModuleName, modulePath :: FilePath }
+  deriving (Eq, Ord, Show)
+
+data Module term = Module { moduleInfo :: ModuleInfo, moduleBody :: term }
   deriving (Eq, Foldable, Functor, Ord, Show, Traversable)
 
 
@@ -22,11 +26,12 @@ moduleForBlob :: Maybe FilePath -- ^ The root directory relative to which the mo
               -> Blob           -- ^ The 'Blob' containing the module.
               -> term           -- ^ The @term@ representing the body of the module.
               -> Module term    -- ^ A 'Module' named appropriate for the 'Blob', holding the @term@, and constructed relative to the root 'FilePath', if any.
-moduleForBlob rootDir blob = Module (moduleNameForPath (modulePathForBlob blob)) (blobPath blob)
+moduleForBlob rootDir blob = Module info
   where modulePathForBlob Blob{..} | Just Go <- blobLanguage = takeDirectory (modulePath blobPath)
                                    | otherwise               =                modulePath blobPath
         -- TODO: Need a better way to handle module registration and resolution
         modulePath = dropExtensions . maybe takeFileName makeRelative rootDir
+        info = ModuleInfo (moduleNameForPath (modulePathForBlob blob)) (blobPath blob)
 
 moduleNameForPath :: FilePath -> ModuleName
 moduleNameForPath = qualifiedName . map BC.pack . splitWhen (== pathSeparator)

src/Data/Abstract/ModuleTable.hs

@@ -2,27 +2,36 @@
 module Data.Abstract.ModuleTable
 ( ModuleName
 , ModuleTable (..)
-, moduleTableLookup
+, singleton
-, moduleTableInsert
+, lookup
-, fromList
+, insert
+, fromModules
+, toPairs
 ) where
 
 import Data.Abstract.Module
 import qualified Data.Map as Map
 import Data.Semigroup
 import GHC.Generics (Generic1)
+import Prelude hiding (lookup)
 
 newtype ModuleTable a = ModuleTable { unModuleTable :: Map.Map ModuleName a }
   deriving (Eq, Foldable, Functor, Generic1, Monoid, Ord, Semigroup, Show, Traversable)
 
-moduleTableLookup :: ModuleName -> ModuleTable a -> Maybe a
+singleton :: ModuleName -> a -> ModuleTable a
-moduleTableLookup k = Map.lookup k . unModuleTable
+singleton name = ModuleTable . Map.singleton name
 
-moduleTableInsert :: ModuleName -> a -> ModuleTable a -> ModuleTable a
+lookup :: ModuleName -> ModuleTable a -> Maybe a
-moduleTableInsert k v ModuleTable{..} = ModuleTable (Map.insert k v unModuleTable)
+lookup k = Map.lookup k . unModuleTable
+
+insert :: ModuleName -> a -> ModuleTable a -> ModuleTable a
+insert k v ModuleTable{..} = ModuleTable (Map.insert k v unModuleTable)
 
 
 -- | Construct a 'ModuleTable' from a list of 'Module's.
-fromList :: [Module term] -> ModuleTable [Module term]
+fromModules :: [Module term] -> ModuleTable [Module term]
-fromList modules = ModuleTable (Map.fromListWith (<>) (map toEntry modules))
+fromModules = ModuleTable . Map.fromListWith (<>) . map toEntry
-  where toEntry m = (moduleName m, [m])
+  where toEntry m = (moduleName (moduleInfo m), [m])
+
+toPairs :: ModuleTable a -> [(ModuleName, a)]
+toPairs = Map.toList . unModuleTable

src/Data/Abstract/Origin.hs

@@ -1,45 +1,100 @@
-{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE GADTs, RankNTypes, UndecidableInstances #-}
 module Data.Abstract.Origin where
 
-import Control.Effect
+import qualified Data.Abstract.Module as M
-import Control.Monad.Effect.Reader
+import qualified Data.Abstract.Package as P
-import Data.Abstract.Module
-import Data.Range
-import Data.Record
-import Data.Span
-import Data.Term
 import Prologue
 
--- TODO: Upstream dependencies
+-- | An 'Origin' encapsulates the location at which a name is bound or allocated.
-data Origin
+data Origin term ty where
-  = Unknown
+  -- | We don’t know anything, or there isn’t even something to know anything about.
-  | Local !ModuleName !FilePath !Range !Span
+  Unknown ::                                    Origin term any
+  -- | We know the package.
+  Package ::                   P.PackageInfo -> Origin term 'P
+  -- | We know the module, and possibly package.
+  Module  :: Origin term 'P -> M.ModuleInfo  -> Origin term 'M
+  -- | We know the term, and possibly module and package.
+  Term    :: Origin term 'M -> Base term ()  -> Origin term 'T
+
+-- | A type index indicating the finest grain of information available in a given 'Origin'.
+data OriginType = P | M | T
   deriving (Eq, Ord, Show)
 
+-- | Project the 'ModuleInfo' out of an 'Origin', if available.
+originModule :: Origin term ty -> Maybe M.ModuleInfo
+originModule (Term o _)   = originModule o
+originModule (Module _ m) = Just m
+originModule _            = Nothing
 
-class HasOrigin f where
+-- | Project the 'PackageInfo' out of an 'Origin', if available.
-  originFor :: [Module a] -> f b -> Origin
+originPackage :: Origin term ty -> Maybe P.PackageInfo
+originPackage (Term o _)   = originPackage o
+originPackage (Module o _) = originPackage o
+originPackage (Package p)  = Just p
+originPackage _            = Nothing
 
-instance (HasField fields Range, HasField fields Span) => HasOrigin (TermF syntax (Record fields)) where
+deriving instance Eq (Base term ()) => Eq (Origin term ty)
-  originFor []    _          = Unknown
+deriving instance Show (Base term ()) => Show (Origin term ty)
-  originFor (m:_) (In ann _) = Local (moduleName m) (modulePath m) (getField ann) (getField ann)
+
+-- | Compare two origins with arbitrary type indices using a function to compare term functors.
+liftCompareOrigins :: (Base term () -> Base term () -> Ordering) -> Origin term ty1 -> Origin term ty2 -> Ordering
+liftCompareOrigins _ Unknown        Unknown        = EQ
+liftCompareOrigins _ Unknown        _              = LT
+liftCompareOrigins _ _              Unknown        = GT
+liftCompareOrigins _ (Package p1)   (Package p2)   = compare p1 p2
+liftCompareOrigins _ (Package _)    _              = LT
+liftCompareOrigins _ _              (Package _)    = GT
+liftCompareOrigins c (Module p1 m1) (Module p2 m2) = liftCompareOrigins c p1 p2 <> compare m1 m2
+liftCompareOrigins _ (Module _ _)   _              = LT
+liftCompareOrigins _ _              (Module _ _)   = GT
+liftCompareOrigins c (Term m1 t1)   (Term m2 t2)   = liftCompareOrigins c m1 m2 <> c t1 t2
+
+instance Ord (Base term ()) => Ord (Origin term ty) where
+  compare = liftCompareOrigins compare
+
+-- | An existential abstraction over 'Origin's of different types.
+data SomeOrigin term where
+  SomeOrigin :: Origin term ty -> SomeOrigin term
+
+-- | Construct a 'SomeOrigin' from 'P.Package' metadata.
+packageOrigin :: P.Package term -> SomeOrigin term
+packageOrigin = SomeOrigin . Package . P.packageInfo
+
+-- | Construct a 'SomeOrigin' from 'M.Module' metadata.
+moduleOrigin :: M.Module term -> SomeOrigin term
+moduleOrigin = SomeOrigin . Module Unknown . M.moduleInfo
+
+-- | Construct a 'SomeOrigin' from a recursive term type.
+termOrigin :: Recursive term => term -> SomeOrigin term
+termOrigin = SomeOrigin . Term Unknown . (() <$) . project
+
+-- | Project information out of a 'SomeOrigin' using a helper function.
+withSomeOrigin :: (forall ty . Origin term ty -> b) -> SomeOrigin term -> b
+withSomeOrigin with (SomeOrigin o) = with o
+
+instance Eq (Base term ()) => Eq (SomeOrigin term) where
+  SomeOrigin o1 == SomeOrigin o2 = liftCompareOrigins (\ t1 t2 -> if t1 == t2 then EQ else LT) o1 o2 == EQ
+
+instance Ord (Base term ()) => Ord (SomeOrigin term) where
+  compare (SomeOrigin o1) (SomeOrigin o2) = liftCompareOrigins compare o1 o2
+
+deriving instance Show (Base term ()) => Show (SomeOrigin term)
 
 
-class Monad m => MonadOrigin m where
+-- | Merge two 'Origin's of possibly differing type indices into a 'SomeOrigin' containing as much information as is available in either side, with ties broken in favour of the right-hand argument.
-  askOrigin :: m Origin
+merge :: Origin term ty1 -> Origin term ty2 -> SomeOrigin term
+merge a                     Unknown                     = SomeOrigin a
+merge (Package p)           (Module Unknown m)          = SomeOrigin (Module (Package p) m)
+merge (Module p _)          (Module Unknown m)          = SomeOrigin (Module p m)
+merge (Term (Module p _) _) (Module Unknown m)          = SomeOrigin (Module p m)
+merge (Term (Module p _) _) (Term (Module Unknown m) t) = SomeOrigin (Term (Module p m) t)
+merge (Module p m)          (Term Unknown t)            = SomeOrigin (Term (Module p m) t)
+merge (Term m _)            (Term Unknown t)            = SomeOrigin (Term m t)
+merge _                     b                           = SomeOrigin b
 
-instance ( Effectful m
+instance Semigroup (SomeOrigin term) where
-         , Member (Reader Origin) effects
+  SomeOrigin a <> SomeOrigin b = merge a b
-         , Monad (m effects)
-         )
-      => MonadOrigin (m effects) where
-  askOrigin = raise ask
 
-
+instance Monoid (SomeOrigin term) where
-instance Semigroup Origin where
+  mempty = SomeOrigin Unknown
-  a       <> Unknown = a
-  _       <> b       = b
-
-instance Monoid Origin where
-  mempty = Unknown
   mappend = (<>)

src/Data/Abstract/Package.hs

@@ -0,0 +1,36 @@
+module Data.Abstract.Package where
+
+import Data.Abstract.FreeVariables
+import Data.Abstract.Module
+import Data.Abstract.ModuleTable as ModuleTable
+
+type PackageName = Name
+
+-- | Metadata for a package (name and version).
+data PackageInfo = PackageInfo
+  { packageName    :: PackageName
+  , packageVersion :: Maybe Version
+  }
+  deriving (Eq, Ord, Show)
+
+newtype Version = Version { versionString :: String }
+  deriving (Eq, Ord, Show)
+
+data PackageBody term = PackageBody
+  { packageModules     :: ModuleTable [Module term]
+  , packageEntryPoints :: ModuleTable (Maybe Name)
+  }
+  deriving (Eq, Functor, Ord, Show)
+
+
+-- | A package represents the unit of dependency, i.e. something which can depend upon, or be depended upon by, other packages. Packages have modules and may have entry points from which evaluation can proceed.
+data Package term = Package
+  { packageInfo :: PackageInfo
+  , packageBody :: PackageBody term
+  }
+  deriving (Eq, Functor, Ord, Show)
+
+fromModules :: [Module term] -> PackageBody term
+fromModules []     = PackageBody mempty mempty
+fromModules (m:ms) = PackageBody (ModuleTable.fromModules (m:ms)) entryPoints
+  where entryPoints = ModuleTable.singleton (moduleName (moduleInfo m)) Nothing

src/Data/Abstract/Type.hs

@@ -60,7 +60,7 @@ instance ( Alternative m
          , Reducer Type (Cell location Type)
          )
       => MonadValue location Type m where
-  abstract names (Subterm _ body) = do
+  lambda names (Subterm _ body) = do
     (env, tvars) <- foldr (\ name rest -> do
       a <- alloc name
       tvar <- Var <$> fresh
@@ -118,7 +118,7 @@ instance ( Alternative m
     (Int, Float) ->                     pure Int
     _                 -> unify left right $> Bool
 
-  apply op params = do
+  call op params = do
     tvar <- fresh
     paramTypes <- sequenceA params
     _ :-> ret <- op `unify` (Product paramTypes :-> Var tvar)

src/Data/Abstract/Value.hs

@@ -296,11 +296,11 @@ instance (Monad m, MonadEvaluatable location term (Value location) m) => MonadVa
     | otherwise = fail ("Type error: invalid binary bitwise operation on " <> show pair)
       where pair = (left, right)
 
-  abstract names (Subterm body _) = do
+  lambda names (Subterm body _) = do
     l <- label body
     injValue . Closure names l . Env.bind (foldr Set.delete (Set.fromList (freeVariables body)) names) <$> getEnv
 
-  apply op params = do
+  call op params = do
     Closure names label env <- maybe (fail ("expected a closure, got: " <> show op)) pure (prjValue op)
     bindings <- foldr (\ (name, param) rest -> do
       v <- param

src/Data/Syntax.hs

@@ -106,7 +106,7 @@ instance Ord1 Identifier where liftCompare = genericLiftCompare
 instance Show1 Identifier where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Identifier where
-  eval (Identifier name) = lookupWith deref name >>= maybe (throwException $ FreeVariableError name) pure
+  eval (Identifier name) = variable name
 
 instance FreeVariables1 Identifier where
   liftFreeVariables _ (Identifier x) = pure x

src/Data/Syntax/Declaration.hs

@@ -22,7 +22,7 @@ instance Show1 Function where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Function where
   eval Function{..} = do
-    (v, addr) <- letrec name (abstract (paramNames functionParameters) functionBody)
+    (v, addr) <- letrec name (lambda (paramNames functionParameters) functionBody)
     modifyEnv (Env.insert name addr)
     pure v
     where paramNames = foldMap (freeVariables . subterm)
@@ -43,7 +43,7 @@ instance Show1 Method where liftShowsPrec = genericLiftShowsPrec
 -- local environment.
 instance Evaluatable Method where
   eval Method{..} = do
-    (v, addr) <- letrec name (abstract (paramNames methodParameters) methodBody)
+    (v, addr) <- letrec name (lambda (paramNames methodParameters) methodBody)
     modifyEnv (Env.insert name addr)
     pure v
     where paramNames = foldMap (freeVariables . subterm)

src/Data/Syntax/Expression.hs

@@ -6,7 +6,7 @@ import Data.Abstract.Number (liftIntegralFrac, liftReal, liftedExponent)
 import Data.Fixed
 import Diffing.Algorithm
 import Prelude
-import Prologue hiding (apply)
+import Prologue
 
 -- | Typical prefix function application, like `f(x)` in many languages, or `f x` in Haskell.
 data Call a = Call { callContext :: ![a], callFunction :: !a, callParams :: ![a], callBlock :: !a }
@@ -19,7 +19,7 @@ instance Show1 Call where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Call where
   eval Call{..} = do
     op <- subtermValue callFunction
-    apply op (map subtermValue callParams)
+    call op (map subtermValue callParams)
 
 data Comparison a
   = LessThan !a !a

src/Language/Ruby/Syntax.hs

@@ -3,7 +3,7 @@ module Language.Ruby.Syntax where
 
 import Control.Monad (unless)
 import Data.Abstract.Evaluatable
-import Data.Abstract.ModuleTable
+import Data.Abstract.ModuleTable as ModuleTable
 import Data.Abstract.Path
 import Diffing.Algorithm
 import Prelude hiding (fail)
@@ -30,9 +30,9 @@ doRequire :: MonadEvaluatable location term value m
           -> m (Environment location value, value)
 doRequire name = do
   moduleTable <- getModuleTable
-  case moduleTableLookup name moduleTable of
+  case ModuleTable.lookup name moduleTable of
-    Nothing -> (,) <$> (fst <$> load name) <*> boolean True
+    Nothing       -> (,) . fst <$> load name <*> boolean True
-    Just (env, _) -> (,) <$> pure env <*> boolean False
+    Just (env, _) -> (,) env   <$>               boolean False
 
 
 newtype Load a = Load { loadArgs :: [a] }

src/Semantic/Util.hs

@@ -15,7 +15,7 @@ import Control.Monad.IO.Class
 import Data.Abstract.Evaluatable hiding (head)
 import Data.Abstract.Address
 import Data.Abstract.Module
-import Data.Abstract.Origin
+import Data.Abstract.Package as Package
 import Data.Abstract.Type
 import Data.Abstract.Value
 import Data.Blob
@@ -70,10 +70,10 @@ evaluateTypeScriptFiles = evaluateFiles typescriptParser
 
 -- Evalute a single file.
 evaluateFile :: forall term effects
-             .  ( Evaluatable (Base term)
+             .  ( Corecursive term
+                , Evaluatable (Base term)
                 , FreeVariables term
                 , effects ~ Effects Precise term (Value Precise) (Evaluating Precise term (Value Precise) effects)
-                , HasOrigin (Base term)
                 , MonadAddressable Precise (Evaluating Precise term (Value Precise) effects)
                 , Recursive term
                 )
@@ -83,10 +83,10 @@ evaluateFile :: forall term effects
 evaluateFile parser path = runAnalysis @(Evaluating Precise term (Value Precise)) . evaluateModule <$> parseFile parser Nothing path
 
 evaluateWith :: forall location value term effects
-             .  ( effects ~ Effects location term value (Evaluating location term value effects)
+             .  ( Corecursive term
+                , effects ~ Effects location term value (Evaluating location term value effects)
                 , Evaluatable (Base term)
                 , FreeVariables term
-                , HasOrigin (Base term)
                 , MonadAddressable location (Evaluating location term value effects)
                 , MonadValue location value (Evaluating location term value effects)
                 , Recursive term
@@ -106,10 +106,10 @@ evaluateWith prelude m = runAnalysis @(Evaluating location term value) $ do
   withDefaultEnvironment preludeEnv (evaluateModule m)
 
 evaluateWithPrelude :: forall term effects
-                    .  ( Evaluatable (Base term)
+                    .  ( Corecursive term
+                       , Evaluatable (Base term)
                        , FreeVariables term
                        , effects ~ Effects Precise term (Value Precise) (Evaluating Precise term (Value Precise) effects)
-                       , HasOrigin (Base term)
                        , MonadAddressable Precise (Evaluating Precise term (Value Precise) effects)
                        , Recursive term
                        , TypeLevel.KnownSymbol (PreludePath term)
@@ -126,10 +126,10 @@ evaluateWithPrelude parser path = do
 
 -- Evaluate a list of files (head of file list is considered the entry point).
 evaluateFiles :: forall term effects
-              .  ( Evaluatable (Base term)
+              .  ( Corecursive term
+                 , Evaluatable (Base term)
                  , FreeVariables term
                  , effects ~ Effects Precise term (Value Precise) (Evaluating Precise term (Value Precise) effects)
-                 , HasOrigin (Base term)
                  , MonadAddressable Precise (Evaluating Precise term (Value Precise) effects)
                  , Recursive term
                  )
@@ -140,10 +140,10 @@ evaluateFiles parser paths = runAnalysis @(Evaluating Precise term (Value Precis
 
 -- | Evaluate terms and an entry point to a value with a given prelude.
 evaluatesWith :: forall location value term effects
-              .  ( effects ~ Effects location term value (Evaluating location term value effects)
+              .  ( Corecursive term
+                 , effects ~ Effects location term value (Evaluating location term value effects)
                  , Evaluatable (Base term)
                  , FreeVariables term
-                 , HasOrigin (Base term)
                  , MonadAddressable location (Evaluating location term value effects)
                  , MonadValue location value (Evaluating location term value effects)
                  , Recursive term
@@ -151,18 +151,17 @@ evaluatesWith :: forall location value term effects
                  , Show location
                  )
               => Module term   -- ^ Prelude to evaluate once
-              -> [Module term] -- ^ List of (blob, term) pairs that make up the program to be evaluated
+              -> [Module term] -- ^ List of modules that make up the program to be evaluated
-              -> Module term   -- ^ Entrypoint
               -> Final effects value
-evaluatesWith prelude modules m = runAnalysis @(Evaluating location term value) $ do
+evaluatesWith prelude modules = runAnalysis @(Evaluating location term value) $ do
   preludeEnv <- evaluateModule prelude *> getEnv
-  withDefaultEnvironment preludeEnv (withModules modules (evaluateModule m))
+  withDefaultEnvironment preludeEnv (evaluateModules modules)
 
 evaluateFilesWithPrelude :: forall term effects
-                         .  ( Evaluatable (Base term)
+                         .  ( Corecursive term
+                            , Evaluatable (Base term)
                             , FreeVariables term
                             , effects ~ Effects Precise term (Value Precise) (Evaluating Precise term (Value Precise) effects)
-                            , HasOrigin (Base term)
                             , MonadAddressable Precise (Evaluating Precise term (Value Precise) effects)
                             , Recursive term
                             , TypeLevel.KnownSymbol (PreludePath term)
@@ -173,8 +172,8 @@ evaluateFilesWithPrelude :: forall term effects
 evaluateFilesWithPrelude parser paths = do
   let preludePath = TypeLevel.symbolVal (Proxy :: Proxy (PreludePath term))
   prelude <- parseFile parser Nothing preludePath
-  entry:xs <- traverse (parseFile parser Nothing) paths
+  xs <- traverse (parseFile parser Nothing) paths
-  pure $ evaluatesWith @Precise @(Value Precise) prelude xs entry
+  pure $ evaluatesWith @Precise @(Value Precise) prelude xs
 
 
 -- Read and parse a file.
@@ -186,6 +185,9 @@ parseFile parser rootDir path = runTask $ do
 parseFiles :: Parser term -> [FilePath] -> IO [Module term]
 parseFiles parser paths = traverse (parseFile parser (Just (dropFileName (head paths)))) paths
 
+parsePackage :: PackageName -> Parser term -> [FilePath] -> IO (Package term)
+parsePackage name parser files = Package (PackageInfo name Nothing) . Package.fromModules <$> parseFiles parser files
+
 
 -- Read a file from the filesystem into a Blob.
 file :: MonadIO m => FilePath -> m Blob

test/SpecHelpers.hs

@@ -13,7 +13,7 @@ import Analysis.Abstract.Evaluating as X (EvaluatingState(..))
 import Data.Abstract.Address as X
 import Data.Abstract.FreeVariables as X hiding (dropExtension)
 import Data.Abstract.Heap as X
-import Data.Abstract.ModuleTable as X
+import Data.Abstract.ModuleTable as X hiding (lookup)
 import Data.Blob as X
 import Data.Functor.Listable as X
 import Data.Language as X