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

🔥 Addressable.

Browse Source
This commit is contained in:
Rob Rix 2018-08-09 15:49:54 -04:00
parent d30cdcfd6a
commit 89b424e75b
1 changed files with 3 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/Control/Abstract/Addressable.hs
View File

@ -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)