Add bindThis to bind objects to closures

Co-Authored-By: Rick Winfrey <rick.winfrey@gmail.com>
Co-Authored-By: Rob Rix <rob.rix@github.com>

src/Control/Abstract/PythonPackage.hs

@@ -70,7 +70,7 @@ instance ( Carrier sig m
     | Just e <- prj op = wrap $ case handleCoercible e of
       Call callName params k -> Evaluator . k =<< do
         case callName of
-          Closure _ _ name' paramNames _ _ _ -> do
+          Closure _ _ name' _ paramNames _ _ _ -> do
             let bindings = foldr (uncurry Map.insert) lowerBound (zip paramNames params)
             let asStrings = asArray >=> traverse asString
 
@@ -89,4 +89,5 @@ instance ( Carrier sig m
         call callName params
       Function name params body scope k -> function name params body scope >>= Evaluator . k
       BuiltIn n b k -> builtIn n b >>= Evaluator . k
+      Bind obj value k -> bindThis obj value >>= Evaluator . k
     | otherwise        = PythonPackagingC (eff (handleCoercible op))

src/Control/Abstract/Value.hs

@@ -7,6 +7,7 @@ module Control.Abstract.Value
 -- $valueEffects
 , function
 , BuiltIn(..)
+, bindThis
 , builtIn
 , call
 , Function(..)
@@ -79,10 +80,14 @@ call fn args = sendFunction (Call fn args ret)
 sendFunction :: (Member (Function term address value) sig, Carrier sig m) => Function term address value (Evaluator term address value m) (Evaluator term address value m a) -> Evaluator term address value m a
 sendFunction = send
 
+bindThis :: (Member (Function term address value) sig, Carrier sig m) => value -> value -> Evaluator term address value m value
+bindThis this that = sendFunction (Bind this that ret)
+
 data Function term address value (m :: * -> *) k
   =  Function Name [Name] term address (value -> k) -- ^ A function is parameterized by its name, parameter names, body, parent scope, and returns a ValueRef.
   | BuiltIn address BuiltIn (value -> k)            -- ^ A built-in is parameterized by its parent scope, BuiltIn type, and returns a value.
   | Call value [value] (value -> k)                 -- ^ A Call takes a set of values as parameters and returns a ValueRef.
+  | Bind value value (value -> k)
   deriving (Functor)
 
 instance HFunctor (Function term address value) where

src/Data/Abstract/Value/Abstract.hs

@@ -53,6 +53,7 @@ instance ( Member (Allocator address) sig
         catchReturn (runFunction (Evaluator . eval) (Evaluator (eval body)))
       Evaluator $ runFunctionC (k res) eval
     BuiltIn _ _ k -> runFunctionC (k Abstract) eval
+    Bind _ _ k -> runFunctionC (k Abstract) eval
     Call _ _ k -> runFunctionC (k Abstract) eval) op)
 
 

src/Data/Abstract/Value/Concrete.hs

@@ -29,7 +29,7 @@ import qualified Data.Map.Strict as Map
 
 data Value term address
                                                                          --  Scope   Frame
-  = Closure PackageInfo ModuleInfo (Maybe Name) [Name] (Either BuiltIn term) address address
+  = Closure PackageInfo ModuleInfo (Maybe Name) (Maybe (Value term address)) [Name] (Either BuiltIn term) address address
   | Unit
   | Boolean Bool
   | Integer  (Number.Number Integer)
@@ -85,7 +85,7 @@ instance ( FreeVariables term
     let closure maybeName params body scope = do
           packageInfo <- currentPackage
           moduleInfo <- currentModule
-          Closure packageInfo moduleInfo maybeName params body scope <$> currentFrame
+          Closure packageInfo moduleInfo maybeName Nothing params body scope <$> currentFrame
 
     in FunctionC (\ eval -> handleSum (eff . handleReader eval runFunctionC) (\case
     Abstract.Function name params body scope k -> runEvaluator $ do
@@ -94,11 +94,14 @@ instance ( FreeVariables term
     Abstract.BuiltIn associatedScope builtIn k -> runEvaluator $ do
       val <- closure Nothing [] (Left builtIn) associatedScope
       Evaluator $ runFunctionC (k val) eval
+    Abstract.Bind obj@(Object frame) (Closure packageInfo moduleInfo name _ names body scope parentFrame) k ->
+      runFunctionC (k (Closure packageInfo moduleInfo name (Just obj) names body scope parentFrame)) eval
+    Abstract.Bind _ value k -> runFunctionC (k value) eval
     Abstract.Call op params k -> runEvaluator $ do
       boxed <- case op of
-        Closure _ _ _ _ (Left Print) _ _ -> traverse (trace . show) params $> Unit
-        Closure _ _ _ _ (Left Show) _ _ -> pure . String . pack $ show params
-        Closure packageInfo moduleInfo _ names (Right body) associatedScope parentFrame -> do
+        Closure _ _ _ _ _ (Left Print) _ _ -> traverse (trace . show) params $> Unit
+        Closure _ _ _ _ _ (Left Show) _ _ -> pure . String . pack $ show params
+        Closure packageInfo moduleInfo _ maybeThis names (Right body) associatedScope parentFrame -> do
           -- Evaluate the bindings and body with the closure’s package/module info in scope in order to
           -- charge them to the closure's origin.
           withCurrentPackage packageInfo . withCurrentModule moduleInfo $ do
@@ -106,6 +109,11 @@ instance ( FreeVariables term
             let frameEdges = Map.singleton Lexical (Map.singleton parentScope parentFrame)
             frameAddress <- newFrame associatedScope frameEdges
             withScopeAndFrame frameAddress $ do
+              case maybeThis of
+                Just object -> do
+                  slot <- lookupDeclaration (Declaration $ name "__self")
+                  assign slot object
+                Nothing -> pure ()
               for_ (zip names params) $ \(name, param) -> do
                 addr <- lookupDeclaration (Declaration name)
                 assign addr param

src/Data/Abstract/Value/Type.hs

@@ -280,6 +280,7 @@ instance ( Member (Allocator address) sig
 
     Abstract.BuiltIn _ Print k -> runFunctionC (k (String :-> Unit)) eval
     Abstract.BuiltIn _ Show  k -> runFunctionC (k (Object :-> String)) eval
+    Abstract.Bind _ value k -> runFunctionC (k value) eval
     Abstract.Call op paramTypes k -> runEvaluator $ do
       tvar <- fresh
       let needed = zeroOrMoreProduct paramTypes :-> Var tvar

src/Data/Syntax/Declaration.hs

@@ -94,7 +94,7 @@ instance Evaluatable Method where
       let self = Name.name "__self"
       -- TODO: Should we give `self` a special Relation?
       declare (Declaration self) Default emptySpan Nothing
-      fmap (self :) . for methodParameters $ \paramNode -> do
+      for methodParameters $ \paramNode -> do
         param <- maybeM (throwEvalError $ NoNameError paramNode) (declaredName paramNode)
         param <$ declare (Declaration param) Default span Nothing
 

src/Data/Syntax/Expression.hs

@@ -503,7 +503,18 @@ instance Ord1 MemberAccess where liftCompare = genericLiftCompare
 instance Show1 MemberAccess where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable MemberAccess where
-  eval eval ref' = ref eval ref' >=> deref
+  eval eval _ MemberAccess{..} = do
+    lhsValue <- eval lhs
+    lhsFrame <- Abstract.scopedEnvironment lhsValue
+    slot <- case lhsFrame of
+      Just lhsFrame ->
+        withScopeAndFrame lhsFrame $ do
+          reference (Reference rhs) (Declaration rhs)
+          lookupDeclaration (Declaration rhs)
+      -- Throw a ReferenceError since we're attempting to reference a name within a value that is not an Object.
+      Nothing -> throwEvalError (ReferenceError lhsValue rhs)
+    value <- deref slot
+    bindThis lhsValue value
 
   ref eval _ MemberAccess{..} = do
     lhsValue <- eval lhs
@@ -647,13 +658,14 @@ instance Evaluatable New where
 
     void . withScopeAndFrame objectFrame $ do
       for_ instanceMembers $ \Data{..} -> do
-        declare dataDeclaration dataRelation dataSpan dataAssociatedScope
+        declare dataDeclaration Default dataSpan dataAssociatedScope
 
       let constructorName = Name.name "constructor"
       reference (Reference constructorName) (Declaration constructorName)
       constructor <- deref =<< lookupDeclaration (Declaration constructorName)
       args <- traverse eval arguments
-      call constructor (objectVal : args)
+      boundConstructor <- bindThis objectVal constructor
+      call boundConstructor args
 
     pure objectVal