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:
parent
de80f1906e
commit
96e68d39fb
@ -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)
|
||||
|
||||
|
@ -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
|
||||
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user