diff --git a/src/Control/Monad/Effect/Address.hs b/src/Control/Monad/Effect/Address.hs index fa8672a51..bf0c1018a 100644 --- a/src/Control/Monad/Effect/Address.hs +++ b/src/Control/Monad/Effect/Address.hs @@ -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) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 550ceee87..b43b6b953 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -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 diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index 434062723..a5bd02a16 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -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 diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index 876d36889..704f64299 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -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