From 1b245278a1d851bb6154fdef4cbacc2ade8b3429 Mon Sep 17 00:00:00 2001 From: Rob Rix Date: Mon, 18 Jun 2018 13:18:20 -0400 Subject: [PATCH] :fire: the value parameter from Modules. --- src/Analysis/Abstract/Graph.hs | 4 ++-- src/Control/Abstract/Modules.hs | 34 +++++++++++++++---------------- src/Data/Abstract/Evaluatable.hs | 8 ++++---- src/Language/Go/Syntax.hs | 2 +- src/Language/PHP/Syntax.hs | 4 ++-- src/Language/Python/Syntax.hs | 4 ++-- src/Language/Ruby/Syntax.hs | 8 ++++---- src/Language/TypeScript/Syntax.hs | 10 ++++----- src/Semantic/Graph.hs | 2 +- src/Semantic/Util.hs | 2 +- test/SpecHelpers.hs | 2 +- 11 files changed, 40 insertions(+), 40 deletions(-) diff --git a/src/Analysis/Abstract/Graph.hs b/src/Analysis/Abstract/Graph.hs index 4939e036b..28d9f5b6d 100644 --- a/src/Analysis/Abstract/Graph.hs +++ b/src/Analysis/Abstract/Graph.hs @@ -76,13 +76,13 @@ graphingPackages recur m = packageInclusion (moduleVertex (moduleInfo m)) *> rec -- | Add vertices to the graph for evaluated modules and the packages containing them. graphingModules :: forall term address value effects a - . ( Member (Modules address value) effects + . ( Member (Modules address) effects , Member (Reader ModuleInfo) effects , Member (State (Graph Vertex)) effects ) => SubtermAlgebra Module term (TermEvaluator term address value effects a) -> SubtermAlgebra Module term (TermEvaluator term address value effects a) -graphingModules recur m = interpose @(Modules address value) pure (\ m yield -> case m of +graphingModules recur m = interpose @(Modules address) pure (\ m yield -> case m of Load path -> moduleInclusion (moduleVertex (ModuleInfo path)) >> send m >>= yield Lookup path -> moduleInclusion (moduleVertex (ModuleInfo path)) >> send m >>= yield _ -> send m >>= yield) diff --git a/src/Control/Abstract/Modules.hs b/src/Control/Abstract/Modules.hs index 52cd1d846..de4a7d829 100644 --- a/src/Control/Abstract/Modules.hs +++ b/src/Control/Abstract/Modules.hs @@ -28,37 +28,37 @@ import Data.Semigroup.Foldable (foldMap1) import Prologue -- | Retrieve an evaluated module, if any. The outer 'Maybe' indicates whether we’ve begun loading the module or not, while the inner 'Maybe' indicates whether we’ve completed loading it or not. Thus, @Nothing@ means we’ve never tried to load it, @Just Nothing@ means we’ve started but haven’t yet finished loading it, and @Just (Just (env, value))@ indicates the result of a completed load. -lookupModule :: Member (Modules address value) effects => ModulePath -> Evaluator address value effects (Maybe (Maybe (address, Environment address))) +lookupModule :: Member (Modules address) effects => ModulePath -> Evaluator address value effects (Maybe (Maybe (address, Environment address))) lookupModule = sendModules . Lookup -- | Resolve a list of module paths to a possible module table entry. -resolve :: forall address value effects . Member (Modules address value) effects => [FilePath] -> Evaluator address value effects (Maybe ModulePath) -resolve = sendModules . Resolve @address @value +resolve :: Member (Modules address) effects => [FilePath] -> Evaluator address value effects (Maybe ModulePath) +resolve = sendModules . Resolve -listModulesInDir :: forall address value effects . Member (Modules address value) effects => FilePath -> Evaluator address value effects [ModulePath] -listModulesInDir = sendModules . List @address @value +listModulesInDir :: Member (Modules address) effects => FilePath -> Evaluator address value effects [ModulePath] +listModulesInDir = sendModules . List -- | Require/import another module by name and return its environment and value. -- -- Looks up the module's name in the cache of evaluated modules first, returns if found, otherwise loads/evaluates the module. -require :: Member (Modules address value) effects => ModulePath -> Evaluator address value effects (Maybe (address, Environment address)) +require :: Member (Modules address) effects => ModulePath -> Evaluator address value effects (Maybe (address, Environment address)) require path = lookupModule path >>= maybeM (load path) -- | Load another module by name and return its environment and value. -- -- Always loads/evaluates. -load :: Member (Modules address value) effects => ModulePath -> Evaluator address value effects (Maybe (address, Environment address)) +load :: Member (Modules address) effects => ModulePath -> Evaluator address value effects (Maybe (address, Environment address)) load path = sendModules (Load path) -data Modules address value return where - Load :: ModulePath -> Modules address value (Maybe (address, Environment address)) - Lookup :: ModulePath -> Modules address value (Maybe (Maybe (address, Environment address))) - Resolve :: [FilePath] -> Modules address value (Maybe ModulePath) - List :: FilePath -> Modules address value [ModulePath] +data Modules address return where + Load :: ModulePath -> Modules address (Maybe (address, Environment address)) + Lookup :: ModulePath -> Modules address (Maybe (Maybe (address, Environment address))) + Resolve :: [FilePath] -> Modules address (Maybe ModulePath) + List :: FilePath -> Modules address [ModulePath] -sendModules :: Member (Modules address value) effects => Modules address value return -> Evaluator address value effects return +sendModules :: Member (Modules address) effects => Modules address return -> Evaluator address value effects return sendModules = send runModules :: forall term address value effects a @@ -66,11 +66,11 @@ runModules :: forall term address value effects a , Member (State (ModuleTable (Maybe (address, Environment address)))) effects , Member Trace effects ) - => (Module term -> Evaluator address value (Modules address value ': effects) (Module (address, Environment address))) - -> Evaluator address value (Modules address value ': effects) a + => (Module term -> Evaluator address value (Modules address ': effects) (Module (address, Environment address))) + -> Evaluator address value (Modules address ': effects) a -> Evaluator address value (Reader (ModuleTable (NonEmpty (Module term))) ': effects) a runModules evaluateModule = go - where go :: forall a . Evaluator address value (Modules address value ': effects) a -> Evaluator address value (Reader (ModuleTable (NonEmpty (Module term))) ': effects) a + where go :: forall a . Evaluator address value (Modules address ': effects) a -> Evaluator address value (Reader (ModuleTable (NonEmpty (Module term))) ': effects) a go = reinterpret (\ m -> case m of Load name -> askModuleTable @term >>= maybe (moduleNotFound name) (runMerging . foldMap (Merging . evalAndCache)) . ModuleTable.lookup name where @@ -92,7 +92,7 @@ runModules evaluateModule = go List dir -> modulePathsInDir dir <$> askModuleTable @term) runModules' :: Member (Reader (ModuleTable (NonEmpty (Module (address, Environment address))))) effects - => Evaluator address value (Modules address value ': effects) a + => Evaluator address value (Modules address ': effects) a -> Evaluator address value effects a runModules' = interpret $ \case Load name -> fmap (runMerging' . foldMap1 (Merging' . moduleBody)) . ModuleTable.lookup name <$> askModuleTable' diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 897017730..2ef1f4f8e 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -49,7 +49,7 @@ class Show1 constr => Evaluatable constr where , Member (Allocator address value) effects , Member (Env address) effects , Member (LoopControl address) effects - , Member (Modules address value) effects + , Member (Modules address) effects , Member (Reader ModuleInfo) effects , Member (Reader PackageInfo) effects , Member (Reader Span) effects @@ -65,8 +65,8 @@ class Show1 constr => Evaluatable constr where evaluate :: forall address term value effects - . ( AbstractValue address value (LoopControl address ': Return address ': Env address ': Allocator address value ': Reader ModuleInfo ': Modules address value ': effects) - , Addressable address (Reader ModuleInfo ': Modules address value ': effects) + . ( AbstractValue address value (LoopControl address ': Return address ': Env address ': Allocator address value ': Reader ModuleInfo ': Modules address ': effects) + , Addressable address (Reader ModuleInfo ': Modules address ': effects) , Declarations term , Evaluatable (Base term) , Foldable (Cell address) @@ -131,7 +131,7 @@ evaluatePackageWith :: forall proxy lang address term value inner inner' inner'' , ValueRoots address value , inner ~ (LoopControl address ': Return address ': Env address ': Allocator address value ': inner') , inner' ~ (Reader ModuleInfo ': inner'') - , inner'' ~ (Modules address value ': Reader Span ': Reader PackageInfo ': outer) + , inner'' ~ (Modules address ': Reader Span ': Reader PackageInfo ': outer) ) => proxy lang -> (SubtermAlgebra Module term (TermEvaluator term address value inner address) -> SubtermAlgebra Module term (TermEvaluator term address value inner address)) diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index de0378bf3..75a1e57fc 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -27,7 +27,7 @@ importPath str = let path = stripQuotes str in ImportPath (T.unpack path) (pathT defaultAlias :: ImportPath -> Name defaultAlias = name . T.pack . takeFileName . unPath -resolveGoImport :: ( Member (Modules address value) effects +resolveGoImport :: ( Member (Modules address) effects , Member (Reader ModuleInfo) effects , Member (Reader Package.PackageInfo) effects , Member (Resumable ResolutionError) effects diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 254e91223..08a7f1e9c 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -35,7 +35,7 @@ instance Evaluatable VariableName -- file, the complete contents of the included file are treated as though it -- were defined inside that function. -resolvePHPName :: ( Member (Modules address value) effects +resolvePHPName :: ( Member (Modules address) effects , Member (Resumable ResolutionError) effects ) => T.Text @@ -49,7 +49,7 @@ resolvePHPName n = do include :: ( AbstractValue address value effects , Member (Allocator address value) effects , Member (Env address) effects - , Member (Modules address value) effects + , Member (Modules address) effects , Member (Resumable ResolutionError) effects , Member (Resumable (EnvironmentError address)) effects , Member Trace effects diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index b968fb218..ed8c6e70f 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -50,7 +50,7 @@ relativeQualifiedName prefix paths = RelativeQualifiedName (T.unpack prefix) (Ju -- Subsequent imports of `parent.two` or `parent.three` will execute -- `parent/two/__init__.py` and -- `parent/three/__init__.py` respectively. -resolvePythonModules :: ( Member (Modules address value) effects +resolvePythonModules :: ( Member (Modules address) effects , Member (Reader ModuleInfo) effects , Member (Resumable ResolutionError) effects , Member Trace effects @@ -126,7 +126,7 @@ instance Evaluatable Import where evalQualifiedImport :: ( AbstractValue address value effects , Member (Allocator address value) effects , Member (Env address) effects - , Member (Modules address value) effects + , Member (Modules address) effects ) => Name -> ModulePath -> Evaluator address value effects value evalQualifiedImport name path = letrec' name $ \addr -> do diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index 821eb026f..06edaadc0 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -16,7 +16,7 @@ import System.FilePath.Posix -- TODO: Fully sort out ruby require/load mechanics -- -- require "json" -resolveRubyName :: ( Member (Modules address value) effects +resolveRubyName :: ( Member (Modules address) effects , Member (Resumable ResolutionError) effects ) => Text @@ -28,7 +28,7 @@ resolveRubyName name = do maybeM (throwResumable $ NotFoundError name' paths Language.Ruby) modulePath -- load "/root/src/file.rb" -resolveRubyPath :: ( Member (Modules address value) effects +resolveRubyPath :: ( Member (Modules address) effects , Member (Resumable ResolutionError) effects ) => Text @@ -73,7 +73,7 @@ instance Evaluatable Require where rvalBox v -- Returns True if the file was loaded, False if it was already loaded. http://ruby-doc.org/core-2.5.0/Kernel.html#method-i-require doRequire :: ( AbstractValue address value effects - , Member (Modules address value) effects + , Member (Modules address) effects ) => M.ModulePath -> Evaluator address value effects (value, Environment address) @@ -102,7 +102,7 @@ instance Evaluatable Load where doLoad :: ( AbstractValue address value effects , Member (Env address) effects - , Member (Modules address value) effects + , Member (Modules address) effects , Member (Resumable ResolutionError) effects , Member Trace effects ) diff --git a/src/Language/TypeScript/Syntax.hs b/src/Language/TypeScript/Syntax.hs index c218876e1..ff708fc30 100644 --- a/src/Language/TypeScript/Syntax.hs +++ b/src/Language/TypeScript/Syntax.hs @@ -35,7 +35,7 @@ toName = name . T.pack . unPath -- -- NB: TypeScript has a couple of different strategies, but the main one (and the -- only one we support) mimics Node.js. -resolveWithNodejsStrategy :: ( Member (Modules address value) effects +resolveWithNodejsStrategy :: ( Member (Modules address) effects , Member (Reader M.ModuleInfo) effects , Member (Reader PackageInfo) effects , Member (Resumable ResolutionError) effects @@ -54,7 +54,7 @@ resolveWithNodejsStrategy (ImportPath path NonRelative) exts = resolveNonRelativ -- /root/src/moduleB.ts -- /root/src/moduleB/package.json (if it specifies a "types" property) -- /root/src/moduleB/index.ts -resolveRelativePath :: ( Member (Modules address value) effects +resolveRelativePath :: ( Member (Modules address) effects , Member (Reader M.ModuleInfo) effects , Member (Reader PackageInfo) effects , Member (Resumable ResolutionError) effects @@ -82,7 +82,7 @@ resolveRelativePath relImportPath exts = do -- -- /root/node_modules/moduleB.ts, etc -- /node_modules/moduleB.ts, etc -resolveNonRelativePath :: ( Member (Modules address value) effects +resolveNonRelativePath :: ( Member (Modules address) effects , Member (Reader M.ModuleInfo) effects , Member (Reader PackageInfo) effects , Member (Resumable ResolutionError) effects @@ -107,7 +107,7 @@ resolveNonRelativePath name exts = do notFound xs = throwResumable $ NotFoundError name xs Language.TypeScript -- | Resolve a module name to a ModulePath. -resolveModule :: ( Member (Modules address value) effects +resolveModule :: ( Member (Modules address) effects , Member (Reader PackageInfo) effects , Member Trace effects ) @@ -133,7 +133,7 @@ javascriptExtensions = ["js"] evalRequire :: ( AbstractValue address value effects , Member (Allocator address value) effects , Member (Env address) effects - , Member (Modules address value) effects + , Member (Modules address) effects ) => M.ModulePath -> Name diff --git a/src/Semantic/Graph.hs b/src/Semantic/Graph.hs index 58cb217b7..ab1b3181d 100644 --- a/src/Semantic/Graph.hs +++ b/src/Semantic/Graph.hs @@ -75,7 +75,7 @@ newtype GraphEff address a = GraphEff , Env address , Allocator address (Value address (GraphEff address)) , Reader ModuleInfo - , Modules address (Value address (GraphEff address)) + , Modules address , Reader Span , Reader PackageInfo , State (Graph Vertex) diff --git a/src/Semantic/Util.hs b/src/Semantic/Util.hs index f9834edb9..6d9455d1e 100644 --- a/src/Semantic/Util.hs +++ b/src/Semantic/Util.hs @@ -47,7 +47,7 @@ newtype UtilEff address a = UtilEff , Env address , Allocator address (Value address (UtilEff address)) , Reader ModuleInfo - , Modules address (Value address (UtilEff address)) + , Modules address , Reader Span , Reader PackageInfo , Resumable (ValueError address (UtilEff address)) diff --git a/test/SpecHelpers.hs b/test/SpecHelpers.hs index edf39923b..4450c8e01 100644 --- a/test/SpecHelpers.hs +++ b/test/SpecHelpers.hs @@ -131,7 +131,7 @@ newtype TestEff a = TestEff , Env Precise , Allocator Precise Val , Reader ModuleInfo - , Modules Precise Val + , Modules Precise , Reader Span , Reader PackageInfo , Resumable (ValueError Precise TestEff)