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

Generalize cacheTerm over the term type.

Browse Source
This commit is contained in:
Rob Rix 2019-07-29 11:59:30 -04:00
parent fdc20a4256
commit c82623db36
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7
1 changed files with 6 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
semantic-core/src/Analysis/FlowInsensitive.hs
View File

@ -13,12 +13,10 @@ import Control.Effect.Fresh
import Control.Effect.NonDet
import Control.Effect.Reader
import Control.Effect.State
import qualified Data.Core as Core
import qualified Data.Map as Map
import Data.Maybe (fromMaybe)
import Data.Monoid (Alt(..))
import qualified Data.Set as Set
import Data.Term (Term)
newtype Cache term a = Cache { unCache :: Map.Map term (Set.Set a) }
deriving (Eq, Ord, Show)
@ -49,16 +47,16 @@ convergeTerm _ eval body = do
get
pure (fromMaybe mempty (Map.lookup body (unCache cache)))
cacheTerm :: forall m sig a name
cacheTerm :: forall m sig a term
. ( Alternative m
, Carrier sig m
, Member (Reader (Cache (Term (Core.Ann :+: Core.Core) name) a)) sig
, Member (State (Cache (Term (Core.Ann :+: Core.Core) name) a)) sig
, Member (Reader (Cache term a)) sig
, Member (State (Cache term a)) sig
, Ord a
, Ord name
, Ord term
)
=> (Term (Core.Ann :+: Core.Core) name -> m a)
-> (Term (Core.Ann :+: Core.Core) name -> m a)
=> (term -> m a)
-> (term -> m a)
cacheTerm eval term = do
cached <- gets (Map.lookup term . unCache)
case cached :: Maybe (Set.Set a) of