1
1
mirror of https://github.com/github/semantic.git synced 2024-12-30 02:14:20 +03:00

split out Addressable into Allocatable and Derefable typeclasses

This commit is contained in:
Charlie Somerville 2018-07-19 17:17:00 +10:00
parent de80f1906e
commit 96e68d39fb
3 changed files with 27 additions and 10 deletions

View File

@ -1,6 +1,8 @@
{-# LANGUAGE GADTs, RankNTypes, TypeFamilies, TypeOperators, UndecidableInstances #-}
module Control.Abstract.Addressable
( Addressable(..)
, Allocatable(..)
, Derefable(..)
) where
import Control.Abstract.Context
@ -11,39 +13,54 @@ import Data.Abstract.Name
import Prologue
-- | Defines allocation and dereferencing of addresses.
class (Ord address, Show address) => Addressable address effects where
class (Ord address, Show address) => Addressable address (effects :: [(* -> *) -> * -> *]) where
-- | The type into which stored values will be written for a given address type.
type family Cell address :: * -> *
class Addressable address effects => Allocatable address effects where
allocCell :: Name -> Evaluator address value effects address
class Addressable address effects => Derefable address effects where
derefCell :: address -> Cell address value -> Evaluator address value effects (Maybe value)
-- | 'Precise' addresses are always allocated a fresh address, and dereference to the 'Latest' value written.
instance Member Fresh effects => Addressable Precise effects where
instance Addressable Precise effects where
type Cell Precise = Latest
instance Member Fresh effects => Allocatable Precise effects where
allocCell _ = Precise <$> fresh
instance Derefable Precise effects where
derefCell _ = pure . getLast . unLatest
-- | 'Monovariant' addresses allocate one address per unique variable name, and dereference once per stored value, nondeterministically.
instance Member NonDet effects => Addressable Monovariant effects where
instance Addressable Monovariant effects where
type Cell Monovariant = All
instance Allocatable Monovariant effects where
allocCell = pure . Monovariant
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, Member (Reader ModuleInfo) effects, Member (Reader PackageInfo) effects) => Addressable (Located address) effects where
instance Addressable address effects => Addressable (Located address) effects where
type Cell (Located address) = Cell address
instance (Allocatable address effects, Member (Reader ModuleInfo) effects, Member (Reader PackageInfo) effects) => Allocatable (Located address) effects where
allocCell name = relocate (Located <$> allocCell name <*> currentPackage <*> currentModule)
instance Derefable address effects => Derefable (Located address) effects where
derefCell (Located loc _ _) = relocate . derefCell loc
instance Addressable address effects => Addressable (Hole address) effects where
type Cell (Hole address) = Cell address
instance Allocatable address effects => Allocatable (Hole address) effects where
allocCell name = relocate (Total <$> allocCell name)
instance Derefable address effects => Derefable (Hole address) effects where
derefCell (Total loc) = relocate . derefCell loc
derefCell Partial = const (pure Nothing)

View File

@ -162,7 +162,7 @@ data Allocator address value (m :: * -> *) return where
data Deref address value (m :: * -> *) return where
Deref :: address -> Deref address value m value
runAllocator :: ( Addressable address effects
runAllocator :: ( Allocatable address effects
, Effects effects
, Foldable (Cell address)
, Member (State (Heap address (Cell address) value)) effects
@ -176,12 +176,10 @@ runAllocator = interpret $ \ eff -> case eff of
Assign addr value -> modifyHeap (heapInsert addr value)
GC roots -> modifyHeap (heapRestrict <*> reachable roots)
runDeref :: ( Addressable address effects
runDeref :: ( Derefable address effects
, Effects effects
, Member (Resumable (AddressError address value)) effects
, Member (State (Heap address (Cell address) value)) effects
, Reducer value (Cell address value)
, ValueRoots address value
)
=> Evaluator address value (Deref address value ': effects) a
-> Evaluator address value effects a

View File

@ -72,8 +72,10 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where
evaluate :: ( AbstractValue address value inner
, Addressable address (Reader ModuleInfo ': effects)
, Addressable address (Allocator address value ': Reader ModuleInfo ': effects)
, Allocatable address (Reader ModuleInfo ': effects)
, Allocatable address (Allocator address value ': Reader ModuleInfo ': effects)
, Derefable address (Reader ModuleInfo ': effects)
, Derefable address (Allocator address value ': Reader ModuleInfo ': effects)
, Declarations term
, Effects effects
, Evaluatable (Base term)