changed scopedEnvironment and evaluateInScopedEnv to take address

src/Control/Abstract/Value.hs

@@ -141,7 +141,7 @@ class (AbstractFunction address value effects, AbstractIntro value) => AbstractV
             -> Evaluator address value effects value
 
   -- | Extract the environment from any scoped object (e.g. classes, namespaces, etc).
-  scopedEnvironment :: value -> Evaluator address value effects (Maybe (Environment address))
+  scopedEnvironment :: address -> Evaluator address value effects (Maybe (Environment address))
 
   -- | Primitive looping combinator, approximately equivalent to 'fix'. This should be used in place of direct recursion, as it allows abstraction over recursion.
   --
@@ -189,7 +189,7 @@ makeNamespace :: ( AbstractValue address value effects
                  )
               => Name
               -> address
-              -> Maybe value
+              -> Maybe address
               -> Evaluator address value effects value
 makeNamespace name addr super = do
   superEnv <- maybe (pure (Just lowerBound)) scopedEnvironment super
@@ -203,11 +203,11 @@ makeNamespace name addr super = do
 evaluateInScopedEnv :: ( AbstractValue address value effects
                        , Member (Env address) effects
                        )
-                    => Evaluator address value effects value
+                    => address
                     -> Evaluator address value effects a
                     -> Evaluator address value effects a
 evaluateInScopedEnv scopedEnvTerm term = do
-  scopedEnv <- scopedEnvTerm >>= scopedEnvironment
+  scopedEnv <- scopedEnvironment scopedEnvTerm
   maybe term (\ env -> locally (bindAll env *> term)) scopedEnv
 
 
@@ -240,7 +240,7 @@ address :: ( AbstractValue address value effects
         => ValueRef address
         -> Evaluator address value effects address
 address (LvalLocal var) = variable var
-address (LvalMember obj prop) = evaluateInScopedEnv (deref obj) (variable prop)
+address (LvalMember ptr prop) = evaluateInScopedEnv ptr (variable prop)
 address (Rval addr) = pure addr
 
 -- | Evaluates a 'Subterm' to the address of its rval

src/Data/Abstract/Value/Concrete.hs

@@ -129,10 +129,9 @@ instance ( Coercible body (Eff effects)
             | Namespace _ env' <- v = pure env'
             | otherwise             = throwValueError $ NamespaceError ("expected " <> show v <> " to be a namespace")
 
-  scopedEnvironment o
-    | Class _ supers binds <- o = (Just . Env.Environment . (binds :|)) <$> ancestorBinds supers
-    | Namespace _ env <- o = pure (Just env)
-    | otherwise = pure Nothing
+  scopedEnvironment ptr = do
+    ancestors <- ancestorBinds [ptr]
+    pure (Env.Environment <$> nonEmpty ancestors)
       where ancestorBinds = (pure . concat) <=< traverse (deref >=> \case
                 Class _ supers binds -> (binds :) <$> ancestorBinds supers
                 Namespace _ env -> pure . toList . Env.unEnvironment $ env

src/Data/Syntax/Expression.hs

@@ -439,7 +439,7 @@ instance Show1 ScopeResolution where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable ScopeResolution where
   eval (ScopeResolution xs) = Rval <$> foldl1 f (fmap subtermAddress xs)
-    where f ns = evaluateInScopedEnv (ns >>= deref)
+    where f ns id = ns >>= flip evaluateInScopedEnv id
 
 
 -- | A non-null expression such as Typescript or Swift's ! expression.

src/Language/PHP/Syntax.hs

@@ -200,7 +200,9 @@ instance Ord1 QualifiedName where liftCompare = genericLiftCompare
 instance Show1 QualifiedName where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable QualifiedName where
-  eval (QualifiedName name iden) = Rval <$> evaluateInScopedEnv (subtermValue name) (subtermAddress iden)
+  eval (QualifiedName name iden) = do
+    namePtr <- subtermAddress name
+    Rval <$> evaluateInScopedEnv namePtr (subtermAddress iden)
 
 newtype NamespaceName a = NamespaceName (NonEmpty a)
   deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Diffable, Mergeable, FreeVariables1, Declarations1, ToJSONFields1)
@@ -212,7 +214,7 @@ instance Show1 NamespaceName where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable NamespaceName where
   eval (NamespaceName xs) = Rval <$> foldl1 f (fmap subtermAddress xs)
-    where f ns = evaluateInScopedEnv (ns >>= deref)
+    where f ns id = ns >>= flip evaluateInScopedEnv id
 
 newtype ConstDeclaration a = ConstDeclaration [a]
   deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Mergeable, Ord, Show, ToJSONFields1, Traversable)

src/Language/Ruby/Syntax.hs

@@ -54,7 +54,7 @@ instance Evaluatable Send where
     let sel = case sendSelector of
           Just sel -> subtermAddress sel
           Nothing  -> variable (name "call")
-    func <- deref =<< maybe sel (flip evaluateInScopedEnv sel . subtermValue) sendReceiver
+    func <- deref =<< maybe sel (flip evaluateInScopedEnv sel <=< subtermAddress) sendReceiver
     Rval <$> call func (map subtermAddress sendArgs) -- TODO pass through sendBlock
 
 data Require a = Require { requireRelative :: Bool, requirePath :: !a }
@@ -131,7 +131,7 @@ instance Show1 Class where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Class where
   eval Class{..} = do
-    super <- traverse subtermValue classSuperClass
+    super <- traverse subtermAddress classSuperClass
     name <- either (throwEvalError . FreeVariablesError) pure (freeVariable $ subterm classIdentifier)
     rvalBox =<< letrec' name (\addr ->
       subtermValue classBody <* makeNamespace name addr super)