mirror of
https://github.com/github/semantic.git
synced 2024-12-22 06:11:49 +03:00
Renamed to match usage
This commit is contained in:
parent
063fab5d17
commit
da3b840953
@ -28,7 +28,7 @@ class (Ord l, Pointed (Cell l)) => MonadAddress l es where
|
||||
-- | Look up or allocate an address for a 'Name' free in a given term & assign it a given value, returning the 'Name' paired with the address.
|
||||
--
|
||||
-- The term is expected to contain one and only one free 'Name', meaning that care should be taken to apply this only to e.g. identifiers.
|
||||
envLookupOrAlloc' :: ( FreeVariables t
|
||||
envLookupOrAlloc :: ( FreeVariables t
|
||||
, Semigroup (Cell (LocationFor a) a)
|
||||
, Member (State (StoreFor a)) es
|
||||
, MonadAddress (LocationFor a) es
|
||||
@ -37,22 +37,22 @@ envLookupOrAlloc' :: ( FreeVariables t
|
||||
-> Environment (LocationFor a) a
|
||||
-> a
|
||||
-> Eff es (Name, Address (LocationFor a) a)
|
||||
envLookupOrAlloc' term = let [name] = toList (freeVariables term) in
|
||||
envLookupOrAlloc name
|
||||
|
||||
-- | Look up or allocate an address for a 'Name' & assign it a given value, returning the 'Name' paired with the address.
|
||||
envLookupOrAlloc :: ( Semigroup (Cell (LocationFor a) a)
|
||||
, Member (State (StoreFor a)) es
|
||||
, MonadAddress (LocationFor a) es
|
||||
)
|
||||
=> Name
|
||||
-> Environment (LocationFor a) a
|
||||
-> a
|
||||
-> Eff es (Name, Address (LocationFor a) a)
|
||||
envLookupOrAlloc name env v = do
|
||||
a <- maybe (alloc name) pure (envLookup name env)
|
||||
assign a v
|
||||
pure (name, a)
|
||||
envLookupOrAlloc term = let [name] = toList (freeVariables term) in
|
||||
envLookupOrAlloc' name
|
||||
where
|
||||
-- | Look up or allocate an address for a 'Name' & assign it a given value, returning the 'Name' paired with the address.
|
||||
envLookupOrAlloc' :: ( Semigroup (Cell (LocationFor a) a)
|
||||
, Member (State (StoreFor a)) es
|
||||
, MonadAddress (LocationFor a) es
|
||||
)
|
||||
=> Name
|
||||
-> Environment (LocationFor a) a
|
||||
-> a
|
||||
-> Eff es (Name, Address (LocationFor a) a)
|
||||
envLookupOrAlloc' name env v = do
|
||||
a <- maybe (alloc name) pure (envLookup name env)
|
||||
assign a v
|
||||
pure (name, a)
|
||||
|
||||
-- | Write a value to the given 'Address' in the 'Store'.
|
||||
assign :: ( Ord (LocationFor a)
|
||||
|
@ -53,7 +53,7 @@ instance ( FreeVariables t
|
||||
let params = toList (freeVariables1 functionParameters)
|
||||
let v = inj (Closure params functionBody env) :: Value l t
|
||||
|
||||
(name, addr) <- envLookupOrAlloc' functionName env v
|
||||
(name, addr) <- envLookupOrAlloc functionName env v
|
||||
modify (envInsert name addr)
|
||||
pure v
|
||||
|
||||
@ -80,7 +80,7 @@ instance Member Fail es => Evaluatable es t Type.Type Function
|
||||
-- let tvars' = fmap (\(_, _, t) -> t) tvars
|
||||
-- let v = Type.Product tvars' :-> outTy
|
||||
--
|
||||
-- (name, a) <- envLookupOrAlloc' functionName env v
|
||||
-- (name, a) <- envLookupOrAlloc functionName env v
|
||||
--
|
||||
-- localEnv (envInsert name a) (yield v)
|
||||
|
||||
@ -98,8 +98,8 @@ instance Show1 Method where liftShowsPrec = genericLiftShowsPrec
|
||||
-- Evaluating a Method creates a closure and makes that value available in the
|
||||
-- local environment.
|
||||
instance ( FreeVariables t -- To get free variables from the function's parameters
|
||||
, Semigroup (Cell l (Value l t)) -- envLookupOrAlloc'
|
||||
, MonadAddress l es -- envLookupOrAlloc'
|
||||
, Semigroup (Cell l (Value l t)) -- envLookupOrAlloc
|
||||
, MonadAddress l es -- envLookupOrAlloc
|
||||
, Member (State (EnvironmentFor (Value l t))) es
|
||||
, Member (Reader (EnvironmentFor (Value l t))) es
|
||||
, Member (State (StoreFor (Value l t))) es
|
||||
@ -109,7 +109,7 @@ instance ( FreeVariables t -- To get free variables from the func
|
||||
let params = toList (freeVariables1 methodParameters)
|
||||
let v = inj (Closure params methodBody env) :: Value l t
|
||||
|
||||
(name, addr) <- envLookupOrAlloc' methodName env v
|
||||
(name, addr) <- envLookupOrAlloc methodName env v
|
||||
modify (envInsert name addr)
|
||||
pure v
|
||||
|
||||
|
@ -11,7 +11,7 @@ import Data.Abstract.Environment
|
||||
import Data.Abstract.Evaluatable
|
||||
import Data.Abstract.FreeVariables
|
||||
import Data.Abstract.Type as Type
|
||||
import Data.Abstract.Value (Value, Closure(..), LocationFor, EnvironmentFor, StoreFor)
|
||||
import Data.Abstract.Value (Value, Closure(..), EnvironmentFor, StoreFor)
|
||||
import Data.Align.Generic
|
||||
import Data.Functor.Classes.Generic
|
||||
import Data.Maybe
|
||||
|
@ -116,7 +116,7 @@ instance ( Semigroup (Cell (LocationFor v) v)
|
||||
eval Assignment{..} = do
|
||||
env <- ask
|
||||
v <- step assignmentValue
|
||||
(var, a) <- envLookupOrAlloc' assignmentTarget env v
|
||||
(var, a) <- envLookupOrAlloc assignmentTarget env v
|
||||
|
||||
modify (envInsert var a)
|
||||
pure v
|
||||
|
Loading…
Reference in New Issue
Block a user