github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-01 09:15:01 +03:00
Code Issues Projects Releases Wiki Activity

Use a State effect to work around https://github.com/joshvera/effects/issues/47

Browse Source
This commit is contained in:
Rob Rix 2018-06-25 11:38:05 -04:00
parent 01b00d3c7b
commit 7552099085
4 changed files with 23 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -62,7 +62,7 @@ data Modules address return where
sendModules :: Member (Modules address) effects => Modules address return -> Evaluator address value effects return
sendModules = send
runModules :: ( Member (Reader (ModuleTable (NonEmpty (Module (address, Environment address))))) effects
runModules :: ( Member (State (ModuleTable (NonEmpty (Module (address, Environment address))))) effects -- FIXME: This should really be a Reader effect but for https://github.com/joshvera/effects/issues/47
, Member (Resumable (LoadError address)) effects
)
=> Set ModulePath
@ -74,8 +74,8 @@ runModules paths = interpret $ \case
Resolve names -> pure (find (flip Set.member paths) names)
List dir -> pure (filter ((dir ==) . takeDirectory) (toList paths))
askModuleTable :: Member (Reader (ModuleTable (NonEmpty (Module (address, Environment address))))) effects => Evaluator address value effects (ModuleTable (NonEmpty (Module (address, Environment address))))
askModuleTable = ask
askModuleTable :: Member (State (ModuleTable (NonEmpty (Module (address, Environment address))))) effects => Evaluator address value effects (ModuleTable (NonEmpty (Module (address, Environment address))))
askModuleTable = get
newtype Merging address = Merging { runMerging :: (address, Environment address) }

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

@ -73,7 +73,7 @@ evaluate :: ( AbstractValue address value inner
, HasPrelude lang
, Member Fresh effects
, Member (Modules address) effects
, Member (Reader (ModuleTable (NonEmpty (Module (address, Environment address))))) effects
, Member (State (ModuleTable (NonEmpty (Module (address, Environment address))))) effects
, Member (Reader PackageInfo) effects
, Member (Reader Span) effects
, Member (Resumable (AddressError address value)) effects
@ -98,10 +98,10 @@ evaluate lang analyzeModule analyzeTerm modules = do
defineBuiltins
definePrelude lang
box unit
foldr (run preludeEnv) ask modules
foldr (run preludeEnv) get modules
where run preludeEnv modules rest = do
evaluated <- traverse (evalModule preludeEnv) modules
local (<> ModuleTable.fromModules (toList evaluated)) rest
localState (<> ModuleTable.fromModules (toList evaluated)) rest
evalModule preludeEnv m
= fmap (<$ m)

12
src/Semantic/Graph.hs
View File

@ -74,7 +74,8 @@ runGraph CallGraph includePackages project
. graphing
. runReader (packageInfo package)
. runReader lowerBound
. runReader lowerBound
. fmap fst
. runState lowerBound
. raiseHandler (runModules (ModuleTable.modulePaths (packageModules package)))
extractGraph <$> analyze runGraphAnalysis (evaluate lang analyzeModule analyzeTerm (topologicalSort modules))
@ -86,7 +87,8 @@ newtype GraphEff address a = GraphEff
, Allocator address (Value address (GraphEff address))
, Reader ModuleInfo
, Modules address
, Reader (ModuleTable (NonEmpty (Module (address, Environment address))))
-- FIXME: This should really be a Reader effect but for https://github.com/joshvera/effects/issues/47
, State (ModuleTable (NonEmpty (Module (address, Environment address))))
, Reader Span
, Reader PackageInfo
, State (Graph Vertex)
@ -137,7 +139,8 @@ runImportGraph lang (package :: Package term)
. resumingAddressError
. resumingValueError
. runState lowerBound
. runReader lowerBound
. fmap fst
. runState lowerBound
. runModules (ModuleTable.modulePaths (packageModules package))
. runTermEvaluator @_ @_ @(Value (Hole Precise) (ImportGraphEff term (Hole Precise)))
. runReader (packageInfo package)
@ -153,7 +156,8 @@ newtype ImportGraphEff term address a = ImportGraphEff
, Reader Span
, Reader PackageInfo
, Modules address
, Reader (ModuleTable (NonEmpty (Module (address, Environment address))))
-- FIXME: This should really be a Reader effect but for https://github.com/joshvera/effects/issues/47
, State (ModuleTable (NonEmpty (Module (address, Environment address))))
, State (Graph ModuleInfo)
, Resumable (ValueError address (ImportGraphEff term address))
, Resumable (AddressError address (Value address (ImportGraphEff term address)))

14
src/Semantic/Util.hs
View File

@ -53,7 +53,7 @@ newtype UtilEff address a = UtilEff
, Allocator address (Value address (UtilEff address))
, Reader ModuleInfo
, Modules address
, Reader (ModuleTable (NonEmpty (Module (address, Environment address))))
, State (ModuleTable (NonEmpty (Module (address, Environment address))))
, Reader Span
, Reader PackageInfo
, Resumable (ValueError address (UtilEff address))
@ -104,9 +104,11 @@ evaluateProject proxy parser lang paths = runTaskWithOptions debugOptions $ do
pure (runTermEvaluator @_ @_ @(Value Precise (UtilEff Precise))
(runReader (packageInfo package)
(runReader (lowerBound @Span)
(runReader (lowerBound @(ModuleTable (NonEmpty (Module (Precise, Environment Precise)))))
-- FIXME: This should really be a Reader effect but for https://github.com/joshvera/effects/issues/47
(fmap fst
(runState (lowerBound @(ModuleTable (NonEmpty (Module (Precise, Environment Precise)))))
(raiseHandler (runModules (ModuleTable.modulePaths (packageModules package)))
(evaluate proxy id withTermSpans modules))))))
(evaluate proxy id withTermSpans modules)))))))
evaluateProjectWithCaching proxy parser lang path = runTaskWithOptions debugOptions $ do
project <- readProject Nothing path lang []
@ -114,9 +116,11 @@ evaluateProjectWithCaching proxy parser lang path = runTaskWithOptions debugOpti
modules <- topologicalSort <$> runImportGraph proxy package
pure (runReader (packageInfo package)
(runReader (lowerBound @Span)
(runReader (lowerBound @(ModuleTable (NonEmpty (Module (Monovariant, Environment Monovariant)))))
-- FIXME: This should really be a Reader effect but for https://github.com/joshvera/effects/issues/47
(fmap fst
(runState (lowerBound @(ModuleTable (NonEmpty (Module (Monovariant, Environment Monovariant)))))
(raiseHandler (runModules (ModuleTable.modulePaths (packageModules package)))
(evaluate proxy id withTermSpans modules)))))
(evaluate proxy id withTermSpans modules))))))
parseFile :: Parser term -> FilePath -> IO term