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

Generalize UtilEff over the trailing effects.

Browse Source
This commit is contained in:
Rob Rix 2018-08-03 11:18:03 -04:00
parent 2389a287a2
commit f2fcbf93f4
2 changed files with 38 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
src/Semantic/Util.hs
View File

@ -53,30 +53,29 @@ justEvaluating
. runAddressError
. runValueError
newtype UtilEff address a = UtilEff
{ runUtilEff :: Eff '[ Function address (Value address (UtilEff address))
, Exc (LoopControl address)
, Exc (Return address)
, Env address
, Deref address (Value address (UtilEff address))
, Allocator address (Value address (UtilEff address))
, Reader ModuleInfo
, Modules address
, Reader (ModuleTable (NonEmpty (Module (ModuleResult address))))
, Reader Span
, Reader PackageInfo
, Resumable (ValueError address (UtilEff address))
, Resumable (AddressError address (Value address (UtilEff address)))
, Resumable ResolutionError
, Resumable EvalError
, Resumable (EnvironmentError address)
, Resumable (Unspecialized (Value address (UtilEff address)))
, Resumable (LoadError address)
, Fresh
, State (Heap address Latest (Value address (UtilEff address)))
, Trace
, Lift IO
] a
newtype UtilEff address rest a = UtilEff
{ runUtilEff :: Eff ( Function address (Value address (UtilEff address rest))
': Exc (LoopControl address)
': Exc (Return address)
': Env address
': Deref address (Value address (UtilEff address rest))
': Allocator address (Value address (UtilEff address rest))
': Reader ModuleInfo
': Modules address
': Reader (ModuleTable (NonEmpty (Module (ModuleResult address))))
': Reader Span
': Reader PackageInfo
': Resumable (ValueError address (UtilEff address rest))
': Resumable (AddressError address (Value address (UtilEff address rest)))
': Resumable ResolutionError
': Resumable EvalError
': Resumable (EnvironmentError address)
': Resumable (Unspecialized (Value address (UtilEff address rest)))
': Resumable (LoadError address)
': Fresh
': State (Heap address Latest (Value address (UtilEff address rest)))
': rest
) a
}
checking
@ -125,7 +124,7 @@ evaluateProject' (TaskConfig config logger statter) proxy parser paths = either
package <- fmap (quieterm . snd) <$> parsePackage parser (Project (takeDirectory (maybe "/" fst (uncons paths))) blobs (Language.reflect proxy) [])
modules <- topologicalSort <$> runImportGraphToModules proxy package
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 (lowerBound @Span)
(runReader (lowerBound @(ModuleTable (NonEmpty (Module (ModuleResult Precise)))))

28
test/SpecHelpers.hs
View File

@ -96,18 +96,19 @@ readFilePair :: Both FilePath -> IO BlobPair
readFilePair paths = let paths' = fmap file paths in
runBothWith IO.readFilePair paths'
type TestEvaluatingEffects = '[ Resumable (ValueError Precise (UtilEff Precise))
, Resumable (AddressError Precise Val)
, Resumable ResolutionError
, Resumable EvalError
, Resumable (EnvironmentError Precise)
, Resumable (Unspecialized Val)
, Resumable (LoadError Precise)
, Trace
, Fresh
, State (Heap Precise Latest Val)
, Lift IO
]
type TestEvaluatingEffects rest
= '[ Resumable (ValueError Precise (UtilEff Precise '[Trace, Lift IO]))
, Resumable (AddressError Precise Val)
, Resumable ResolutionError
, Resumable EvalError
, Resumable (EnvironmentError Precise)
, Resumable (Unspecialized Val)
, Resumable (LoadError Precise)
, Fresh
, State (Heap Precise Latest Val)
, Trace
, Lift IO
]
type TestEvaluatingErrors = '[ ValueError Precise (UtilEff Precise)
, AddressError Precise Val
, ResolutionError
@ -126,10 +127,9 @@ testEvaluating :: Evaluator Precise Val TestEvaluatingEffects (ModuleTable (NonE
)
testEvaluating
= runM
. fmap (\ (heap, (traces, res)) -> (traces, (heap, res)))
. runReturningTrace
. runState lowerBound
. runFresh 0
. runReturningTrace
. fmap reassociate
. runLoadError
. runUnspecialized