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

Line the types up.

Browse Source 
Co-Authored-By: Rick Winfrey <rick.winfrey@gmail.com>
This commit is contained in:
Rob Rix 2018-06-25 15:56:00 -04:00
parent c9d340affb
commit 935ac3015f
3 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -91,7 +91,7 @@ evaluate :: ( AbstractValue address value inner
=> proxy lang => proxy lang
-> (SubtermAlgebra Module term (TermEvaluator term address value inner address) -> SubtermAlgebra Module term (TermEvaluator term address value inner address)) -> (SubtermAlgebra Module term (TermEvaluator term address value inner address) -> SubtermAlgebra Module term (TermEvaluator term address value inner address))
-> (SubtermAlgebra (Base term) term (TermEvaluator term address value inner (ValueRef address)) -> SubtermAlgebra (Base term) term (TermEvaluator term address value inner (ValueRef address))) -> (SubtermAlgebra (Base term) term (TermEvaluator term address value inner (ValueRef address)) -> SubtermAlgebra (Base term) term (TermEvaluator term address value inner (ValueRef address)))
-> [NonEmpty (Module term)] -> [Module term]
-> TermEvaluator term address value effects (ModuleTable (NonEmpty (Module (address, Environment address)))) -> TermEvaluator term address value effects (ModuleTable (NonEmpty (Module (address, Environment address))))
evaluate lang analyzeModule analyzeTerm modules = do evaluate lang analyzeModule analyzeTerm modules = do
(_, preludeEnv) <- TermEvaluator . runInModule lowerBound moduleInfoFromCallStack $ do (_, preludeEnv) <- TermEvaluator . runInModule lowerBound moduleInfoFromCallStack $ do
@ -99,9 +99,9 @@ evaluate lang analyzeModule analyzeTerm modules = do
definePrelude lang definePrelude lang
box unit box unit
foldr (run preludeEnv) get modules foldr (run preludeEnv) get modules
where run preludeEnv modules rest = do where run preludeEnv m rest = do
evaluated <- traverse (evalModule preludeEnv) modules evaluated <- evalModule preludeEnv m
modify' (<> ModuleTable.fromModules (toList evaluated)) modify' (ModuleTable.insert (modulePath (moduleInfo evaluated)) (evaluated :| []))
rest rest
evalModule preludeEnv m evalModule preludeEnv m

2
src/Semantic/Graph.hs
View File

@ -145,7 +145,7 @@ runImportGraph lang (package :: Package term)
. runTermEvaluator @_ @_ @(Value (Hole Precise) (ImportGraphEff term (Hole Precise))) . runTermEvaluator @_ @_ @(Value (Hole Precise) (ImportGraphEff term (Hole Precise)))
. runReader (packageInfo package) . runReader (packageInfo package)
. runReader lowerBound . runReader lowerBound
in extractGraph <$> analyze runImportGraphAnalysis (evaluate @_ @_ @_ @_ @term lang analyzeModule analyzeTerm (map snd (ModuleTable.toPairs (packageModules package)))) in extractGraph <$> analyze runImportGraphAnalysis (evaluate @_ @_ @_ @_ @term lang analyzeModule analyzeTerm (ModuleTable.toPairs (packageModules package) >>= toList . snd))
newtype ImportGraphEff term address a = ImportGraphEff newtype ImportGraphEff term address a = ImportGraphEff
{ runImportGraphEff :: Eff '[ LoopControl address { runImportGraphEff :: Eff '[ LoopControl address

2
src/Semantic/Util.hs
View File

@ -100,7 +100,7 @@ typecheckGoFile = checking <=< evaluateProjectWithCaching (Proxy :: Proxy 'Langu
evaluateProject proxy parser lang paths = runTaskWithOptions debugOptions $ do evaluateProject proxy parser lang paths = runTaskWithOptions debugOptions $ do
package <- fmap quieterm <$> parsePackage parser (Project (takeDirectory (maybe "/" fst (uncons paths))) (flip File lang <$> paths) lang []) package <- fmap quieterm <$> parsePackage parser (Project (takeDirectory (maybe "/" fst (uncons paths))) (flip File lang <$> paths) lang [])
modules <- topologicalSort <$> runImportGraph proxy package modules <- topologicalSort <$> runImportGraph proxy package
trace $ "evaluating with load order: " <> show (map (modulePath . moduleInfo) . toList <$> modules) trace $ "evaluating with load order: " <> show (map (modulePath . moduleInfo) modules)
pure (runTermEvaluator @_ @_ @(Value Precise (UtilEff Precise)) pure (runTermEvaluator @_ @_ @(Value Precise (UtilEff Precise))
(runReader (packageInfo package) (runReader (packageInfo package)
(runReader (lowerBound @Span) (runReader (lowerBound @Span)