diff --git a/src/Control/Abstract/PythonPackage.hs b/src/Control/Abstract/PythonPackage.hs index 228a28ba8..6b02ca199 100644 --- a/src/Control/Abstract/PythonPackage.hs +++ b/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)) diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 73b65f479..c89980dc0 100644 --- a/src/Control/Abstract/Value.hs +++ b/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 diff --git a/src/Data/Abstract/Value/Abstract.hs b/src/Data/Abstract/Value/Abstract.hs index 589724057..fa84bd3f4 100644 --- a/src/Data/Abstract/Value/Abstract.hs +++ b/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) diff --git a/src/Data/Abstract/Value/Concrete.hs b/src/Data/Abstract/Value/Concrete.hs index bac75aa0d..d787e5772 100644 --- a/src/Data/Abstract/Value/Concrete.hs +++ b/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 diff --git a/src/Data/Abstract/Value/Type.hs b/src/Data/Abstract/Value/Type.hs index 113605ae3..b01351feb 100644 --- a/src/Data/Abstract/Value/Type.hs +++ b/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 diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 4f2d6e7a9..8f13a3789 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/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 diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index 5abf83c9f..a983101c1 100644 --- a/src/Data/Syntax/Expression.hs +++ b/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