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

Silence unspecialized exceptions.

Browse Source
This commit is contained in:
Rob Rix 2018-03-26 10:28:14 -04:00
parent a9c5955027
commit 587c078171
1 changed files with 9 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
src/Analysis/Abstract/Quiet.hs
View File

@ -1,7 +1,9 @@
{-# LANGUAGE GeneralizedNewtypeDeriving, TypeFamilies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, TypeApplications, TypeFamilies #-}
module Analysis.Abstract.Quiet where
import Control.Abstract.Analysis
import Control.Monad.Effect.Resumable
import Data.Abstract.Evaluatable
import Prologue
newtype Quietly m term value (effects :: [* -> *]) a = Quietly (m term value effects a)
@ -13,10 +15,14 @@ deriving instance MonadHeap value (m term value effects) => MonadHeap value (Qui
deriving instance MonadModuleTable term value (m term value effects) => MonadModuleTable term value (Quietly m term value effects)
deriving instance MonadEvaluator term value (m term value effects) => MonadEvaluator term value (Quietly m term value effects)
instance MonadAnalysis term value (m term value effects)
instance ( Effectful (m term value)
, Member (Resumable (Unspecialized value)) effects
, MonadAnalysis term value (m term value effects)
, MonadValue value (Quietly m term value effects)
)
=> MonadAnalysis term value (Quietly m term value effects) where
type RequiredEffects term value (Quietly m term value effects) = RequiredEffects term value (m term value effects)
analyzeTerm = liftAnalyze analyzeTerm
analyzeTerm eval term = resumeException @(Unspecialized value) (liftAnalyze analyzeTerm eval term) (\yield (Unspecialized _) -> unit >>= yield)
analyzeModule = liftAnalyze analyzeModule