1
1
mirror of https://github.com/github/semantic.git synced 2024-11-28 10:15:55 +03:00

Rename Allocator to Store.

This commit is contained in:
Rob Rix 2018-05-31 08:47:16 -04:00
parent 9f1e73cd07
commit 42540a1e20
11 changed files with 29 additions and 29 deletions

View File

@ -78,7 +78,7 @@ cachingTerms recur term = do
convergingModules :: ( AbstractValue address value effects
, Cacheable term address (Cell address) value
, Member (Allocator address value) effects
, Member (Store address value) effects
, Member Fresh effects
, Member NonDet effects
, Member (Reader (Cache term address (Cell address) value)) effects

View File

@ -12,8 +12,8 @@ module Control.Abstract.Heap
, letrec'
, variable
-- * Effects
, Allocator(..)
, runAllocator
, Store(..)
, runStore
, AddressError(..)
, runAddressError
, runAddressErrorWith
@ -41,11 +41,11 @@ modifyHeap :: Member (State (Heap address (Cell address) value)) effects => (Hea
modifyHeap = modify'
alloc :: forall address value effects . Member (Allocator address value) effects => Name -> Evaluator address value effects address
alloc :: forall address value effects . Member (Store address value) effects => Name -> Evaluator address value effects address
alloc = send . Alloc @address @value
-- | Dereference the given address in the heap, or fail if the address is uninitialized.
deref :: Member (Allocator address value) effects => address -> Evaluator address value effects value
deref :: Member (Store address value) effects => address -> Evaluator address value effects value
deref = send . Deref
@ -61,7 +61,7 @@ assign address = modifyHeap . heapInsert address
-- | Look up or allocate an address for a 'Name'.
lookupOrAlloc :: ( Member (Allocator address value) effects
lookupOrAlloc :: ( Member (Store address value) effects
, Member (Env address) effects
)
=> Name
@ -69,7 +69,7 @@ lookupOrAlloc :: ( Member (Allocator address value) effects
lookupOrAlloc name = lookupEnv name >>= maybeM (alloc name)
letrec :: ( Member (Allocator address value) effects
letrec :: ( Member (Store address value) effects
, Member (Env address) effects
, Member (State (Heap address (Cell address) value)) effects
, Ord address
@ -85,7 +85,7 @@ letrec name body = do
pure (v, addr)
-- Lookup/alloc a name passing the address to a body evaluated in a new local environment.
letrec' :: ( Member (Allocator address value) effects
letrec' :: ( Member (Store address value) effects
, Member (Env address) effects
)
=> Name
@ -98,7 +98,7 @@ letrec' name body = do
-- | Look up and dereference the given 'Name', throwing an exception for free variables.
variable :: ( Member (Allocator address value) effects
variable :: ( Member (Store address value) effects
, Member (Env address) effects
, Member (Resumable (EnvironmentError address)) effects
)
@ -109,12 +109,12 @@ variable name = lookupEnv name >>= maybeM (freeVariableError name) >>= deref
-- Effects
data Allocator address value return where
Alloc :: Name -> Allocator address value address
Deref :: address -> Allocator address value value
data Store address value return where
Alloc :: Name -> Store address value address
Deref :: address -> Store address value value
runAllocator :: (Addressable address effects, Effectful (m address value), Member (Resumable (AddressError address value)) effects, Member (State (Heap address (Cell address) value)) effects) => m address value (Allocator address value ': effects) a -> m address value effects a
runAllocator = raiseHandler (interpret (\ eff -> case eff of
runStore :: (Addressable address effects, Effectful (m address value), Member (Resumable (AddressError address value)) effects, Member (State (Heap address (Cell address) value)) effects) => m address value (Store address value ': effects) a -> m address value effects a
runStore = raiseHandler (interpret (\ eff -> case eff of
Alloc name -> lowerEff $ allocCell name
Deref addr -> lowerEff $ heapLookup addr <$> get >>= maybeM (throwResumable (UnallocatedAddress addr)) >>= derefCell addr >>= maybeM (throwResumable (UninitializedAddress addr))))

View File

@ -13,7 +13,7 @@ import Data.Semilattice.Lower
import Prologue
builtin :: ( HasCallStack
, Member (Allocator address value) effects
, Member (Store address value) effects
, Member (Env address) effects
, Member (Reader ModuleInfo) effects
, Member (Reader Span) effects
@ -39,7 +39,7 @@ lambda body = do
defineBuiltins :: ( AbstractValue address value effects
, HasCallStack
, Member (Allocator address value) effects
, Member (Store address value) effects
, Member (Env address) effects
, Member Fresh effects
, Member (Reader ModuleInfo) effects

View File

@ -218,7 +218,7 @@ evaluateInScopedEnv scopedEnvTerm term = do
-- | Evaluates a 'Value' returning the referenced value
value :: ( AbstractValue address value effects
, Member (Allocator address value) effects
, Member (Store address value) effects
, Member (Env address) effects
, Member (Resumable (EnvironmentError address)) effects
)
@ -230,7 +230,7 @@ value (Rval val) = pure val
-- | Evaluates a 'Subterm' to its rval
subtermValue :: ( AbstractValue address value effects
, Member (Allocator address value) effects
, Member (Store address value) effects
, Member (Env address) effects
, Member (Resumable (EnvironmentError address)) effects
)

View File

@ -52,7 +52,7 @@ type EvaluatableConstraints address term value effects =
( AbstractValue address value effects
, Declarations term
, FreeVariables term
, Member (Allocator address value) effects
, Member (Store address value) effects
, Member (Env address) effects
, Member (LoopControl value) effects
, Member (Modules address value) effects
@ -85,7 +85,7 @@ evaluatePackageWith :: forall address term value inner inner' inner'' outer
, Member (State (ModuleTable (Maybe (value, Environment address)))) outer
, Member Trace outer
, Recursive term
, inner ~ (LoopControl value ': Return value ': Env address ': Allocator address value ': inner')
, inner ~ (LoopControl value ': Return value ': Env address ': Store address value ': inner')
, inner' ~ (Reader ModuleInfo ': inner'')
, inner'' ~ (Modules address value ': Reader Span ': Reader PackageInfo ': outer)
)
@ -111,7 +111,7 @@ evaluatePackageWith analyzeModule analyzeTerm package
runInModule preludeEnv info
= runReader info
. raiseHandler runAllocator
. raiseHandler runStore
. raiseHandler (runEnv preludeEnv)
. raiseHandler runReturn
. raiseHandler runLoopControl

View File

@ -116,7 +116,7 @@ instance AbstractIntro Type where
null = Null
instance ( Member (Allocator address Type) effects
instance ( Member (Store address Type) effects
, Member (Env address) effects
, Member Fresh effects
, Member (Resumable TypeError) effects
@ -145,7 +145,7 @@ instance ( Member (Allocator address Type) effects
-- | Discard the value arguments (if any), constructing a 'Type' instead.
instance ( Member (Allocator address Type) effects
instance ( Member (Store address Type) effects
, Member (Env address) effects
, Member Fresh effects
, Member NonDet effects

View File

@ -55,7 +55,7 @@ instance AbstractHole (Value address body) where
hole = Hole
instance ( Coercible body (Eff effects)
, Member (Allocator address (Value address body)) effects
, Member (Store address (Value address body)) effects
, Member (Env address) effects
, Member Fresh effects
, Member (Reader ModuleInfo) effects
@ -108,7 +108,7 @@ instance Show address => AbstractIntro (Value address body) where
-- | Construct a 'Value' wrapping the value arguments (if any).
instance ( Coercible body (Eff effects)
, Member (Allocator address (Value address body)) effects
, Member (Store address (Value address body)) effects
, Member (Env address) effects
, Member Fresh effects
, Member (LoopControl (Value address body)) effects

View File

@ -53,7 +53,7 @@ resolvePHPName n = do
toName = BC.unpack . dropRelativePrefix . stripQuotes
include :: ( AbstractValue address value effects
, Member (Allocator address value) effects
, Member (Store address value) effects
, Member (Env address) effects
, Member (Modules address value) effects
, Member (Resumable ResolutionError) effects

View File

@ -128,7 +128,7 @@ instance Evaluatable Import where
-- Evaluate a qualified import
evalQualifiedImport :: ( AbstractValue address value effects
, Member (Allocator address value) effects
, Member (Store address value) effects
, Member (Env address) effects
, Member (Modules address value) effects
, Member (State (Heap address (Cell address) value)) effects

View File

@ -134,7 +134,7 @@ javascriptExtensions :: [String]
javascriptExtensions = ["js"]
evalRequire :: ( AbstractValue address value effects
, Member (Allocator address value) effects
, Member (Store address value) effects
, Member (Env address) effects
, Member (Modules address value) effects
, Member (State (Heap address (Cell address) value)) effects

View File

@ -37,7 +37,7 @@ evaluate
. runValueError
. runEnvironmentError
. runAddressError
. runAllocator
. runStore
. runEnv lowerBound
. runReturn
. runLoopControl