github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-21 13:51:44 +03:00
Code Issues Projects Releases Wiki Activity

MonadEvaluator does not imply Fail.

Browse Source
This commit is contained in:
Rob Rix 2018-04-25 18:10:05 -04:00
parent 15dcb44302
commit a6fbc1fe22
2 changed files with 4 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -34,8 +34,7 @@ type EvaluatingEffects location term value
, State (EvaluatorState location term value) -- Environment, heap, modules, exports, and jumps. , State (EvaluatorState location term value) -- Environment, heap, modules, exports, and jumps.
] ]
instance ( Member Fail effects instance ( Member (Reader (Environment location value)) effects
, Member (Reader (Environment location value)) effects
, Member (Reader (ModuleTable [Module term])) effects , Member (Reader (ModuleTable [Module term])) effects
, Member (Reader (SomeOrigin term)) effects , Member (Reader (SomeOrigin term)) effects
, Member (State (EvaluatorState location term value)) effects , Member (State (EvaluatorState location term value)) effects
@ -43,7 +42,6 @@ instance ( Member Fail effects
=> MonadEvaluator location term value effects (Evaluating location term value) => MonadEvaluator location term value effects (Evaluating location term value)
instance ( Corecursive term instance ( Corecursive term
, Member Fail effects
, Member (Reader (Environment location value)) effects , Member (Reader (Environment location value)) effects
, Member (Reader (ModuleTable [Module term])) effects , Member (Reader (ModuleTable [Module term])) effects
, Member (Reader (SomeOrigin term)) effects , Member (Reader (SomeOrigin term)) effects

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

@ -83,7 +83,6 @@ import Prologue
-- - a heap mapping addresses to (possibly sets of) values -- - a heap mapping addresses to (possibly sets of) values
-- - tables of modules available for import -- - tables of modules available for import
class ( Effectful m class ( Effectful m
, Member Fail effects
, Member (Reader (Environment location value)) effects , Member (Reader (Environment location value)) effects
, Member (Reader (ModuleTable [Module term])) effects , Member (Reader (ModuleTable [Module term])) effects
, Member (Reader (SomeOrigin term)) effects , Member (Reader (SomeOrigin term)) effects
@ -327,13 +326,13 @@ modifyLoadStack f = do
-- | Get the currently evaluating 'ModuleInfo'. -- | Get the currently evaluating 'ModuleInfo'.
currentModule :: forall location term value effects m . MonadEvaluator location term value effects m => m effects ModuleInfo currentModule :: forall location term value effects m . (Member Fail effects, MonadEvaluator location term value effects m) => m effects ModuleInfo
currentModule = do currentModule = do
o <- raise ask o <- raise ask
maybeM (raise (fail "unable to get currentModule")) $ withSomeOrigin (originModule @term) o maybeM (raise (fail "unable to get currentModule")) $ withSomeOrigin (originModule @term) o
-- | Get the currently evaluating 'PackageInfo'. -- | Get the currently evaluating 'PackageInfo'.
currentPackage :: forall location term value effects m . MonadEvaluator location term value effects m => m effects PackageInfo currentPackage :: forall location term value effects m . (Member Fail effects, MonadEvaluator location term value effects m) => m effects PackageInfo
currentPackage = do currentPackage = do
o <- raise ask o <- raise ask
maybeM (raise (fail "unable to get currentPackage")) $ withSomeOrigin (originPackage @term) o maybeM (raise (fail "unable to get currentPackage")) $ withSomeOrigin (originPackage @term) o
@ -352,7 +351,7 @@ label term = do
pure i pure i
-- | “Jump” to a previously-allocated 'Label' (retrieving the @term@ at which it points, which can then be evaluated in e.g. a 'MonadAnalysis' instance). -- | “Jump” to a previously-allocated 'Label' (retrieving the @term@ at which it points, which can then be evaluated in e.g. a 'MonadAnalysis' instance).
goto :: MonadEvaluator location term value effects m => Label -> m effects term goto :: (Member Fail effects, MonadEvaluator location term value effects m) => Label -> m effects term
goto label = IntMap.lookup label <$> view _jumps >>= maybe (raise (fail ("unknown label: " <> show label))) pure goto label = IntMap.lookup label <$> view _jumps >>= maybe (raise (fail ("unknown label: " <> show label))) pure