mirror of
https://github.com/github/semantic.git
synced 2024-11-24 17:04:47 +03:00
🔥 Addressable.
This commit is contained in:
parent
d30cdcfd6a
commit
89b424e75b
@ -1,7 +1,6 @@
|
||||
{-# LANGUAGE GADTs, RankNTypes, TypeFamilies, TypeOperators, UndecidableInstances #-}
|
||||
module Control.Abstract.Addressable
|
||||
( Addressable
|
||||
, Allocatable(..)
|
||||
( Allocatable(..)
|
||||
, Derefable(..)
|
||||
) where
|
||||
|
||||
@ -13,21 +12,15 @@ import Data.Abstract.Name
|
||||
import qualified Data.Set as Set
|
||||
import Prologue
|
||||
|
||||
-- | Defines allocation and dereferencing of addresses.
|
||||
class (Ord address, Show address) => Addressable address (effects :: [(* -> *) -> * -> *]) where
|
||||
|
||||
class Addressable address effects => Allocatable address effects where
|
||||
class (Ord address, Show address) => Allocatable address effects where
|
||||
allocCell :: Name -> Evaluator address value effects address
|
||||
|
||||
assignCell :: Ord value => address -> value -> Set value -> Evaluator address value effects (Set value)
|
||||
|
||||
class Addressable address effects => Derefable address effects where
|
||||
class (Ord address, Show address) => Derefable address effects where
|
||||
derefCell :: address -> Set value -> Evaluator address value effects (Maybe value)
|
||||
|
||||
|
||||
-- | 'Precise' addresses are always allocated a fresh address, and dereference to the 'Latest' value written.
|
||||
instance Addressable Precise effects where
|
||||
|
||||
instance Member Fresh effects => Allocatable Precise effects where
|
||||
allocCell _ = Precise <$> fresh
|
||||
|
||||
@ -36,8 +29,6 @@ instance Member Fresh effects => Allocatable Precise effects where
|
||||
instance Derefable Precise effects where
|
||||
derefCell _ = pure . fmap fst . Set.minView
|
||||
|
||||
-- | 'Monovariant' addresses allocate one address per unique variable name, and dereference once per stored value, nondeterministically.
|
||||
instance Addressable Monovariant effects where
|
||||
|
||||
instance Allocatable Monovariant effects where
|
||||
allocCell = pure . Monovariant
|
||||
@ -47,8 +38,6 @@ instance Allocatable Monovariant effects where
|
||||
instance Member NonDet effects => Derefable Monovariant effects where
|
||||
derefCell _ = traverse (foldMapA pure) . nonEmpty . toList
|
||||
|
||||
-- | 'Located' addresses allocate & dereference using the underlying address, contextualizing addresses with the current 'PackageInfo' & 'ModuleInfo'.
|
||||
instance Addressable address effects => Addressable (Located address) effects where
|
||||
|
||||
instance (Allocatable address effects, Member (Reader ModuleInfo) effects, Member (Reader PackageInfo) effects, Member (Reader Span) effects) => Allocatable (Located address) effects where
|
||||
allocCell name = relocate (Located <$> allocCell name <*> currentPackage <*> currentModule <*> pure name <*> ask)
|
||||
@ -58,7 +47,6 @@ instance (Allocatable address effects, Member (Reader ModuleInfo) effects, Membe
|
||||
instance Derefable address effects => Derefable (Located address) effects where
|
||||
derefCell (Located loc _ _ _ _) = relocate . derefCell loc
|
||||
|
||||
instance (Addressable address effects, Ord context, Show context) => Addressable (Hole context address) effects where
|
||||
|
||||
instance (Allocatable address effects, Ord context, Show context) => Allocatable (Hole context address) effects where
|
||||
allocCell name = relocate (Total <$> allocCell name)
|
||||
|
Loading…
Reference in New Issue
Block a user