github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-29 18:06:14 +03:00
Code Issues Projects Releases Wiki Activity

Module table entries have to be non-empty.

Browse Source
This commit is contained in:
Rob Rix 2018-04-30 17:11:34 -04:00
parent 405c12f574
commit 7c9c975071
8 changed files with 35 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
src/Analysis/Abstract/Evaluating.hs
View File

@ -24,16 +24,16 @@ type EvaluatingEffects location term value
, EvalModule term value
, Return value
, LoopControl value
, Fail -- Failure with an error message
, Fresh -- For allocating new addresses and/or type variables.
, Reader (SomeOrigin term) -- 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 (EvaluatorState location term value) -- Environment, heap, modules, exports, and jumps.
, Fail -- Failure with an error message
, Fresh -- For allocating new addresses and/or type variables.
, Reader (SomeOrigin term) -- The current term’s origin.
, Reader (ModuleTable (NonEmpty (Module term))) -- Cache of unevaluated modules
, Reader (Environment location value) -- Default environment used as a fallback in lookupEnv
, State (EvaluatorState location term value) -- Environment, heap, modules, exports, and jumps.
]
instance ( Member (Reader (Environment location value)) effects
, Member (Reader (ModuleTable [Module term])) effects
, Member (Reader (ModuleTable (NonEmpty (Module term)))) effects
, Member (Reader (SomeOrigin term)) effects
, Member (State (EvaluatorState location term value)) effects
)
@ -41,7 +41,7 @@ instance ( Member (Reader (Environment location value)) effects
instance ( Corecursive term
, Member (Reader (Environment location value)) effects
, Member (Reader (ModuleTable [Module term])) effects
, Member (Reader (ModuleTable (NonEmpty (Module term)))) effects
, Member (Reader (SomeOrigin term)) effects
, Member (State (EvaluatorState location term value)) effects
, Recursive term

11
src/Analysis/Abstract/ImportGraph.hs
View File

@ -13,13 +13,14 @@ import Data.Abstract.Address
import Data.Abstract.Evaluatable (LoadError (..))
import Data.Abstract.FreeVariables
import Data.Abstract.Located
import Data.Abstract.Module hiding (Module)
import qualified Data.Abstract.Module as Module
import Data.Abstract.Origin hiding (Module, Package)
import Data.Abstract.Package hiding (Package)
import Data.Aeson hiding (Result)
import qualified Data.ByteString.Char8 as BC
import Data.ByteString.Lazy (toStrict)
import Data.Output
import Data.Semilattice.Lower
import qualified Data.Syntax as Syntax
import Data.Term
import Data.Text.Encoding as T
@ -60,8 +61,10 @@ deriving instance MonadEvaluator location term value effects m => MonadEvaluator
instance ( Effectful m
, Lower ann
, Member (Resumable (LoadError term)) effects
, Member (State ImportGraph) effects
, Member Syntax.Empty syntax
, Member Syntax.Identifier syntax
, MonadAnalysis (Located location term) term value effects m
, term ~ Term (Union syntax) ann
@ -76,10 +79,10 @@ instance ( Effectful m
resume
@(LoadError term)
(liftAnalyze analyzeTerm eval term)
(\yield (LoadError name) -> moduleInclusion (Module (BC.pack name)) >> yield [])
(\yield (LoadError name) -> moduleInclusion (Module (BC.pack name)) *> yield (Module.Module (Module.ModuleInfo name) (termIn lowerBound (inj Syntax.Empty)) :|[]))
analyzeModule recur m = do
let name = BC.pack (modulePath (moduleInfo m))
let name = BC.pack (Module.modulePath (Module.moduleInfo m))
packageInclusion (Module name)
moduleInclusion (Module name)
liftAnalyze analyzeModule recur m
@ -88,7 +91,7 @@ packageGraph :: SomeOrigin term -> ImportGraph
packageGraph = maybe empty (vertex . Package . unName . packageName) . withSomeOrigin originPackage
moduleGraph :: SomeOrigin term -> ImportGraph
moduleGraph = maybe empty (vertex . Module . BC.pack . modulePath) . withSomeOrigin originModule
moduleGraph = maybe empty (vertex . Module . BC.pack . Module.modulePath) . withSomeOrigin originModule
-- | Add an edge from the current package to the passed vertex.
packageInclusion :: forall m location term value effects

6
src/Control/Abstract/Evaluator.hs
View File

@ -94,7 +94,7 @@ import Prologue
-- - tables of modules available for import
class ( Effectful m
, Member (Reader (Environment location value)) effects
, Member (Reader (ModuleTable [Module term])) effects
, Member (Reader (ModuleTable (NonEmpty (Module term)))) effects
, Member (Reader (SomeOrigin term)) effects
, Member (State (EvaluatorState location term value)) effects
, Monad (m effects)
@ -309,11 +309,11 @@ modifyModuleTable f = do
-- | Retrieve the table of unevaluated modules.
askModuleTable :: MonadEvaluator location term value effects m => m effects (ModuleTable [Module term])
askModuleTable :: MonadEvaluator location term value effects m => m effects (ModuleTable (NonEmpty (Module term)))
askModuleTable = raise ask
-- | Run an action with a locally-modified table of unevaluated modules.
localModuleTable :: MonadEvaluator location term value effects m => (ModuleTable [Module term] -> ModuleTable [Module term]) -> m effects a -> m effects a
localModuleTable :: MonadEvaluator location term value effects m => (ModuleTable (NonEmpty (Module term)) -> ModuleTable (NonEmpty (Module term))) -> m effects a -> m effects a
localModuleTable f = raiseHandler (local f)

16
src/Data/Abstract/Evaluatable.hs
View File

@ -79,7 +79,7 @@ instance Eq1 (ResolutionError value) where
-- | An error thrown when loading a module from the list of provided modules. Indicates we weren't able to find a module with the given name.
data LoadError term resume where
LoadError :: ModulePath -> LoadError term [Module term]
LoadError :: ModulePath -> LoadError term (NonEmpty (Module term))
deriving instance Eq (LoadError term resume)
deriving instance Show (LoadError term resume)
@ -224,17 +224,10 @@ loadWith :: ( Member (Resumable (LoadError term)) effects
=> (Module term -> m effects value)
-> ModulePath
-> m effects (Environment location value, value)
loadWith with name = askModuleTable >>= maybeM notFound . ModuleTable.lookup name >>= evalAndCache
loadWith with name = askModuleTable >>= maybeM notFound . ModuleTable.lookup name >>= runMerging . foldMap1 (Merging . evalAndCache')
where
notFound = throwResumable (LoadError name)
evalAndCache [] = (,) emptyEnv <$> unit
evalAndCache [x] = evalAndCache' x
evalAndCache (x:xs) = do
(env, _) <- evalAndCache' x
(env', v') <- evalAndCache xs
pure (mergeEnvs env env', v')
evalAndCache' x = do
let mPath = modulePath (moduleInfo x)
LoadStack{..} <- getLoadStack
@ -259,6 +252,11 @@ loadWith with name = askModuleTable >>= maybeM notFound . ModuleTable.lookup nam
| Exports.null ports = env
| otherwise = Exports.toEnvironment ports `mergeEnvs` overwrite (Exports.aliases ports) env
newtype Merging m location value = Merging { runMerging :: m (Environment location value, value) }
instance Applicative m => Semigroup (Merging m location value) where
Merging a <> Merging b = Merging (merging <$> a <*> b)
where merging (env1, _) (env2, v) = (mergeEnvs env1 env2, v)
-- | Evaluate a (root-level) term to a value using the semantics of the current analysis.
evalModule :: forall location term value effects m

4
src/Data/Abstract/ModuleTable.hs
View File

@ -46,9 +46,9 @@ keys :: ModuleTable a -> [ModulePath]
keys = Map.keys . unModuleTable
-- | Construct a 'ModuleTable' from a list of 'Module's.
fromModules :: [Module term] -> ModuleTable [Module term]
fromModules :: [Module term] -> ModuleTable (NonEmpty (Module term))
fromModules modules = ModuleTable (Map.fromListWith (<>) (map toEntry modules))
where toEntry m = (modulePath (moduleInfo m), [m])
where toEntry m = (modulePath (moduleInfo m), m:|[])
toPairs :: ModuleTable a -> [(ModulePath, a)]
toPairs = Map.toList . unModuleTable

3
src/Data/Abstract/Package.hs
View File

@ -5,6 +5,7 @@ import Data.Abstract.FreeVariables
import Data.Abstract.Module
import Data.Abstract.ModuleTable as ModuleTable
import qualified Data.Map as Map
import Prologue
type PackageName = Name
@ -19,7 +20,7 @@ newtype Version = Version { versionString :: String }
deriving (Eq, Ord, Show)
data PackageBody term = PackageBody
{ packageModules :: ModuleTable [Module term]
{ packageModules :: ModuleTable (NonEmpty (Module term))
, packagePrelude :: Maybe (Module term)
, packageEntryPoints :: ModuleTable (Maybe Name)
}

3
src/Parsing/Parser.hs
View File

@ -52,7 +52,8 @@ type family ApplyAll' (typeclasses :: [(* -> *) -> Constraint]) (fs :: [* -> *])
-- | A parser, suitable for program analysis, for some specific language, producing 'Term's whose syntax satisfies a list of typeclass constraints.
data SomeAnalysisParser typeclasses ann where
SomeAnalysisParser :: ( Member Syntax.Identifier fs
SomeAnalysisParser :: ( Member Syntax.Empty fs
, Member Syntax.Identifier fs
, ApplyAll' typeclasses fs)
=> Parser (Term (Union fs) ann) -- ^ A parser.
-> Maybe File -- ^ Maybe path to prelude.

5
src/Semantic/Graph.hs
View File

@ -19,6 +19,7 @@ import Data.Abstract.Package as Package
import Data.Abstract.Value (Value)
import Data.File
import Data.Output
import Data.Semilattice.Lower
import qualified Data.Syntax as Syntax
import Data.Term
import Parsing.Parser
@ -76,8 +77,9 @@ type ImportGraphAnalysis term
(Value (Located Precise term)))))))))
-- | Render the import graph for a given 'Package'.
graphImports :: ( Show ann
graphImports :: ( Lower ann
, Ord ann
, Show ann
, Apply Analysis.Declarations1 syntax
, Apply Analysis.Evaluatable syntax
, Apply FreeVariables1 syntax
@ -85,6 +87,7 @@ graphImports :: ( Show ann
, Apply Ord1 syntax
, Apply Eq1 syntax
, Apply Show1 syntax
, Member Syntax.Empty syntax
, Member Syntax.Identifier syntax
, Members '[Exc SomeException, Task] effs
)