1
1
mirror of https://github.com/github/semantic.git synced 2024-12-22 14:21:31 +03:00

Renamed to match usage

This commit is contained in:
Timothy Clem 2018-02-23 11:16:07 -08:00
parent 063fab5d17
commit da3b840953
4 changed files with 24 additions and 24 deletions

View File

@ -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. -- | 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. -- 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) , Semigroup (Cell (LocationFor a) a)
, Member (State (StoreFor a)) es , Member (State (StoreFor a)) es
, MonadAddress (LocationFor a) es , MonadAddress (LocationFor a) es
@ -37,11 +37,11 @@ envLookupOrAlloc' :: ( FreeVariables t
-> Environment (LocationFor a) a -> Environment (LocationFor a) a
-> a -> a
-> Eff es (Name, Address (LocationFor a) a) -> Eff es (Name, Address (LocationFor a) a)
envLookupOrAlloc' term = let [name] = toList (freeVariables term) in envLookupOrAlloc term = let [name] = toList (freeVariables term) in
envLookupOrAlloc name envLookupOrAlloc' name
where
-- | Look up or allocate an address for a 'Name' & assign it a given value, returning the 'Name' paired with the address. -- | 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) envLookupOrAlloc' :: ( Semigroup (Cell (LocationFor a) a)
, Member (State (StoreFor a)) es , Member (State (StoreFor a)) es
, MonadAddress (LocationFor a) es , MonadAddress (LocationFor a) es
) )
@ -49,7 +49,7 @@ envLookupOrAlloc :: ( Semigroup (Cell (LocationFor a) a)
-> Environment (LocationFor a) a -> Environment (LocationFor a) a
-> a -> a
-> Eff es (Name, Address (LocationFor a) a) -> Eff es (Name, Address (LocationFor a) a)
envLookupOrAlloc name env v = do envLookupOrAlloc' name env v = do
a <- maybe (alloc name) pure (envLookup name env) a <- maybe (alloc name) pure (envLookup name env)
assign a v assign a v
pure (name, a) pure (name, a)

View File

@ -53,7 +53,7 @@ instance ( FreeVariables t
let params = toList (freeVariables1 functionParameters) let params = toList (freeVariables1 functionParameters)
let v = inj (Closure params functionBody env) :: Value l t 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) modify (envInsert name addr)
pure v pure v
@ -80,7 +80,7 @@ instance Member Fail es => Evaluatable es t Type.Type Function
-- let tvars' = fmap (\(_, _, t) -> t) tvars -- let tvars' = fmap (\(_, _, t) -> t) tvars
-- let v = Type.Product tvars' :-> outTy -- let v = Type.Product tvars' :-> outTy
-- --
-- (name, a) <- envLookupOrAlloc' functionName env v -- (name, a) <- envLookupOrAlloc functionName env v
-- --
-- localEnv (envInsert name a) (yield 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 -- Evaluating a Method creates a closure and makes that value available in the
-- local environment. -- local environment.
instance ( FreeVariables t -- To get free variables from the function's parameters instance ( FreeVariables t -- To get free variables from the function's parameters
, Semigroup (Cell l (Value l t)) -- envLookupOrAlloc' , Semigroup (Cell l (Value l t)) -- envLookupOrAlloc
, MonadAddress l es -- envLookupOrAlloc' , MonadAddress l es -- envLookupOrAlloc
, Member (State (EnvironmentFor (Value l t))) es , Member (State (EnvironmentFor (Value l t))) es
, Member (Reader (EnvironmentFor (Value l t))) es , Member (Reader (EnvironmentFor (Value l t))) es
, Member (State (StoreFor (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 params = toList (freeVariables1 methodParameters)
let v = inj (Closure params methodBody env) :: Value l t 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) modify (envInsert name addr)
pure v pure v

View File

@ -11,7 +11,7 @@ import Data.Abstract.Environment
import Data.Abstract.Evaluatable import Data.Abstract.Evaluatable
import Data.Abstract.FreeVariables import Data.Abstract.FreeVariables
import Data.Abstract.Type as Type 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.Align.Generic
import Data.Functor.Classes.Generic import Data.Functor.Classes.Generic
import Data.Maybe import Data.Maybe

View File

@ -116,7 +116,7 @@ instance ( Semigroup (Cell (LocationFor v) v)
eval Assignment{..} = do eval Assignment{..} = do
env <- ask env <- ask
v <- step assignmentValue v <- step assignmentValue
(var, a) <- envLookupOrAlloc' assignmentTarget env v (var, a) <- envLookupOrAlloc assignmentTarget env v
modify (envInsert var a) modify (envInsert var a)
pure v pure v