1
1
mirror of https://github.com/github/semantic.git synced 2024-11-24 08:54:07 +03:00

Generalize the Cache type over the term type.

This commit is contained in:
Rob Rix 2019-07-29 11:58:02 -04:00
parent 7b6b6a4259
commit 05fa90ef84
No known key found for this signature in database
GPG Key ID: F188A01508EA1CF7

View File

@ -20,7 +20,7 @@ import Data.Monoid (Alt(..))
import qualified Data.Set as Set
import Data.Term (Term)
newtype Cache name a = Cache { unCache :: Map.Map (Term (Core.Ann :+: Core.Core) name) (Set.Set a) }
newtype Cache term a = Cache { unCache :: Map.Map term (Set.Set a) }
deriving (Eq, Ord, Show)
type Heap address a = Map.Map address (Set.Set a)
@ -39,12 +39,12 @@ convergeTerm :: forall m sig a name address proxy
, Ord name
)
=> proxy address
-> (Term (Core.Ann :+: Core.Core) name -> NonDetC (ReaderC (Cache name a) (StateC (Cache name a) m)) a)
-> (Term (Core.Ann :+: Core.Core) name -> NonDetC (ReaderC (Cache (Term (Core.Ann :+: Core.Core) name) a) (StateC (Cache (Term (Core.Ann :+: Core.Core) name) a) m)) a)
-> Term (Core.Ann :+: Core.Core) name
-> m (Set.Set a)
convergeTerm _ eval body = do
heap <- get
(cache, _) <- converge (Cache Map.empty :: Cache name a, heap :: Heap address a) $ \ (prevCache, _) -> runState (Cache Map.empty) . runReader prevCache $ do
(cache, _) <- converge (Cache Map.empty :: Cache (Term (Core.Ann :+: Core.Core) name) a, heap :: Heap address a) $ \ (prevCache, _) -> runState (Cache Map.empty) . runReader prevCache $ do
_ <- resetFresh . runNonDetM Set.singleton $ eval body
get
pure (fromMaybe mempty (Map.lookup body (unCache cache)))
@ -52,8 +52,8 @@ convergeTerm _ eval body = do
cacheTerm :: forall m sig a name
. ( Alternative m
, Carrier sig m
, Member (Reader (Cache name a)) sig
, Member (State (Cache name a)) sig
, Member (Reader (Cache (Term (Core.Ann :+: Core.Core) name) a)) sig
, Member (State (Cache (Term (Core.Ann :+: Core.Core) name) a)) sig
, Ord a
, Ord name
)