Fix up a couple more eval instances

and comment out even more

edgelabel-scratchpad

@@ -106,15 +106,62 @@ Lexical* . (Public* | Import*)
 
 -- Class
 
+predicate :: [EdgeLabel] -> Bool -> [EdgeLabel] -> Bool
+predicate =
+
 class A { -- Scope 1
     public a = 2; -- declare a in scope 1, make a new scope with a public edge to 1
+
     private b = 3; -- declare b in scope 2, make a new scope with a private edge to 2
     protected c = 4; -- declare c in scope 3, make a new scope with a protected edge to 3
     private d = 3; -- declare b in scope 2, make a new scope with a private edge to 2
+
+    function e () {
+      this.f();
+    }
+
+    function f () {
+        if (true) e();
+    }
+
 }
 
-predicate :: [EdgeLabel] -> Bool -> [EdgeLabel] -> Bool
-predicate =
+a
+|
+Public
+|
+b
+|
+Private
+|
+c
+|
+Protected
+|
+d
+|
+Private
+|
+*
+
+*
+|
+Public
+|
+a
+|
+Private
+|
+b
+|
+Protected
+|
+c
+|
+Private
+|
+d
+
 
 instance Evaluatable Class where
     eval = do
@@ -122,6 +169,9 @@ instance Evaluatable Class where
         withPredicate publicOrProtectedThroughSuperclassesOrAnythingLocal . locally (eval body)
 
 class B < A {
+    public c;
+    private c;
+    protected c;
 
     class C < D { -- C has a Lexical edge to B and an import edge to D
         withPredicate publicOrProtectedThroughSuperclassesOrAnythingLocal . locally (eval body)
@@ -133,7 +183,8 @@ class B < A {
     }
 
     -- Inheritance edge predicate
-    -- Lexical* . (Private | Protected | Public)* . (Import . (Protected | Private | Public)* . (Protected | Public))*
+    -- Lexical* . (Private | Protected | Public)* .
+         ((Private | Protected | Public) | (Import . (Protected | Private | Public)* . (Protected | Public))*)
     -- Instance edge predicate
     -- Import . (Protected | Private)* . Public
 }
@@ -184,6 +235,13 @@ C
 -- module ModuleWithBar
 -- function bar() {} * Lexical
 
+bar
+|
+Lexical
+|
+Import
+*
+
 -- module B
 -- import ModuleWithBar * Import
 -- function foo() {} * Lexical

src/Control/Abstract/Value.hs

@@ -299,7 +299,7 @@ value :: ( AbstractValue address value effects
       -> Evaluator address value effects value
 value (Rval val) = pure val
 value (LvalLocal name) = undefined
-value (LvalMember lhs rhs) = undefined
+value (LvalMember slot) = undefined
 
 -- | Evaluates a 'Subterm' to its rval
 subtermValue :: ( AbstractValue address value effects

src/Data/Abstract/Evaluatable.hs

@@ -63,6 +63,7 @@ class (Show1 constr, Foldable constr) => Evaluatable constr where
           , Member (Reader Span) effects
           , Member (State Span) effects
           , Member (Resumable (BaseError (ScopeError address))) effects
+          , Member (Resumable (BaseError (HeapError address))) effects
           , Member (Resumable (BaseError (AddressError address value))) effects
           , Member (Resumable (BaseError (UnspecializedError value))) effects
           , Member (Resumable (BaseError EvalError)) effects

src/Data/Abstract/Ref.hs

@@ -5,6 +5,7 @@ module Data.Abstract.Ref
   ) where
 
 import Data.Abstract.Name
+import Data.Abstract.ScopeGraph (Address)
 
 -- | 'ValueRef' is the type subterms evaluate to and can represent either values directly ('Rval'), or references to values (lvals - such as local variables or object members)
 data ValueRef address value where
@@ -13,7 +14,7 @@ data ValueRef address value where
   -- | A local variable. No environment is attached—it’s assumed that 'LvalLocal' will be evaluated in the same scope it was constructed in.
   LvalLocal  :: Name -> ValueRef address value
   -- | An object member.
-  LvalMember :: address -> Name -> ValueRef address value
+  LvalMember :: Address address -> ValueRef address value
 
 deriving instance (Eq value, Eq address) => Eq (ValueRef address value)
 deriving instance (Ord value, Ord address) => Ord (ValueRef address value)

src/Data/Abstract/ScopeGraph.hs

@@ -32,6 +32,7 @@ import           Prologue
 import qualified Data.Sequence as Seq
 
 data Address address = Address { address :: address, position :: Position }
+    deriving (Eq, Show, Ord)
 
 -- Offsets and frame addresses in the heap should be addresses?
 data Scope address = Scope {

src/Language/Go/Syntax.hs

@@ -18,6 +18,7 @@ import           Proto3.Suite
 import qualified Proto3.Wire.Encode as Encode
 import qualified Proto3.Wire.Decode as Decode
 import           System.FilePath.Posix
+import qualified Data.Abstract.ScopeGraph as ScopeGraph
 
 data IsRelative = Unknown | Relative | NonRelative
   deriving (Bounded, Enum, Finite, Eq, Generic, Hashable, Ord, Show, ToJSON, Named, MessageField)
@@ -93,8 +94,9 @@ instance Evaluatable Import where
     paths <- resolveGoImport importPath
     for_ paths $ \path -> do
       traceResolve (unPath importPath) path
-      importedEnv <- fst . snd <$> require path
-      bindAll importedEnv
+      scopeGraph <- fst <$> require path
+      bindAll scopeGraph
+      insertEdge ScopeGraph.Import (currentScope scopeGraph)
     rvalBox unit
 
 

src/Language/PHP/Syntax.hs

@@ -12,6 +12,9 @@ import qualified Data.Text as T
 import           Diffing.Algorithm
 import           Prologue hiding (Text)
 import           Proto3.Suite.Class
+import Control.Abstract.ScopeGraph
+import qualified Data.Abstract.ScopeGraph as ScopeGraph
+import qualified Data.Map.Strict as Map
 
 newtype Text a = Text { value :: T.Text }
   deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)
@@ -53,13 +56,13 @@ resolvePHPName n = do
 
 include :: ( AbstractValue address value effects
            , Member (Deref value) effects
-           , Member (Env address) effects
            , Member (Modules address value) effects
            , Member (Reader ModuleInfo) effects
            , Member (Reader Span) effects
            , Member (Resumable (BaseError (AddressError address value))) effects
+           , Member (Resumable (BaseError (ScopeError address))) effects
+           , Member (State (ScopeGraph address)) effects
            , Member (Resumable (BaseError ResolutionError)) effects
-           , Member (Resumable (BaseError (EnvironmentError address))) effects
            , Member (State (Heap address address value)) effects
            , Member Trace effects
            , Ord address
@@ -71,8 +74,9 @@ include pathTerm f = do
   name <- subtermValue pathTerm >>= asString
   path <- resolvePHPName name
   traceResolve name path
-  (_, (importedEnv, v)) <- f path
-  bindAll importedEnv
+  (scopeGraph, v) <- f path
+  bindAll scopeGraph
+  maybe (pure ()) (insertEdge ScopeGraph.Import) (ScopeGraph.currentScope scopeGraph)
   pure (Rval v)
 
 newtype Require a = Require { value :: a }
@@ -210,9 +214,24 @@ instance Ord1 QualifiedName where liftCompare = genericLiftCompare
 instance Show1 QualifiedName where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable QualifiedName where
-  eval (QualifiedName name iden) = do
-    namePtr <- subtermAddress name
-    Rval <$> evaluateInScopedEnv namePtr (subtermAddress iden)
+  eval (QualifiedName obj iden) = do
+    name <- maybeM (throwEvalError NoNameError) (declaredName (subterm obj))
+    reference (Reference name) (Declaration name)
+    childScope <- associatedScope (Declaration name)
+
+    propName <- maybeM (throwEvalError NoNameError) (declaredName (subterm iden))
+    case childScope of
+      Just childScope -> do
+        currentScopeAddress <- currentScope
+        currentFrameAddress <- currentFrame
+        frameAddress <- newFrame childScope (Map.singleton Lexical (Map.singleton currentScopeAddress currentFrameAddress))
+        withScopeAndFrame frameAddress $ do
+          reference (Reference propName) (Declaration propName)
+          address <- lookupDeclaration (Declaration propName)
+          pure $! LvalMember address
+      Nothing ->
+        -- TODO: Throw an ReferenceError because we can't find the associated child scope for `obj`.
+        rvalBox unit
 
 newtype NamespaceName a = NamespaceName { names :: NonEmpty a }
   deriving (Eq, Ord, Show, Foldable, Traversable, Functor, Generic1, Diffable, FreeVariables1, Declarations1, ToJSONFields1, Named1, Message1)
@@ -223,8 +242,9 @@ instance Ord1 NamespaceName where liftCompare = genericLiftCompare
 instance Show1 NamespaceName where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable NamespaceName where
-  eval (NamespaceName xs) = Rval <$> foldl1 f (fmap subtermAddress xs)
-    where f ns id = ns >>= flip evaluateInScopedEnv id
+  eval (NamespaceName xs) = rvalBox unit
+    -- Rval <$> foldl1 f (fmap subtermAddress xs)
+    -- where f ns id = ns >>= flip evaluateInScopedEnv id
 
 newtype ConstDeclaration a = ConstDeclaration { values :: [a] }
   deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Ord, Show, ToJSONFields1, Traversable, Named1, Message1)

src/Language/Python/Syntax.hs

@@ -21,6 +21,8 @@ import Proto3.Suite (Primitive(..), Message(..), Message1(..), Named1(..), Named
 import qualified Proto3.Suite as Proto
 import qualified Proto3.Wire.Encode as Encode
 import qualified Proto3.Wire.Decode as Decode
+import Control.Abstract.ScopeGraph (Allocator, bindAll, insertEdge, declare, Declaration(..))
+import qualified Data.Abstract.ScopeGraph as ScopeGraph
 
 data QualifiedName
   = QualifiedName { paths :: NonEmpty FilePath }
@@ -131,7 +133,11 @@ instance Evaluatable Import where
   -- This is a bit of a special case in the syntax as this actually behaves like a qualified relative import.
   eval (Import (RelativeQualifiedName n Nothing) [Alias{..}]) = do
     path <- NonEmpty.last <$> resolvePythonModules (RelativeQualifiedName n (Just (qualifiedName (formatName aliasValue :| []))))
-    rvalBox =<< evalQualifiedImport aliasValue path
+    scopeGraph <- fst <$> require path
+    bindAll scopeGraph
+    span <- ask @Span
+    declare (Declaration aliasValue) span (ScopeGraph.currentScope scopeGraph)
+    rvalBox unit
 
   -- from a import b
   -- from a import b as c
@@ -145,28 +151,19 @@ instance Evaluatable Import where
 
     -- Last module path is the one we want to import
     let path = NonEmpty.last modulePaths
-    importedBinds <- fst . snd <$> require path
-    bindAll (select importedBinds)
+    scopeGraph <- fst <$> require path
+    bindAll scopeGraph
+    if Prologue.null xs then
+      maybe (pure ()) (insertEdge ScopeGraph.Import) (ScopeGraph.currentScope scopeGraph)
+    else
+      for_ xs $ \Alias{..} -> do
+        -- TODO: Add an Alias Edge to resolve qualified export froms
+        -- Scope 1 -> alias (bar, foo) -> Export 3 -> Export -> Scope 4
+        pure ()
+
     rvalBox unit
-    where
-      select importedBinds
-        | Prologue.null xs = importedBinds
-        | otherwise = Env.aliasBindings (toTuple <$> xs) importedBinds
 
 
--- Evaluate a qualified import
-evalQualifiedImport :: ( AbstractValue address value effects
-                       , Member (Allocator address) effects
-                       , Member (Deref value) effects
-                       , Member (Env address) effects
-                       , Member (Modules address value) effects
-                       , Member (State (Heap address address value)) effects
-                       , Ord address
-                       )
-                    => Name -> ModulePath -> Evaluator address value effects value
-evalQualifiedImport name path = letrec' name $ \addr -> do
-  unit <$ makeNamespace name addr Nothing (bindAll . fst . snd =<< require path)
-
 newtype QualifiedImport a = QualifiedImport { qualifiedImportFrom :: NonEmpty FilePath }
   deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Named1, Ord, Show, ToJSONFields1, Traversable)
 
@@ -190,14 +187,15 @@ instance Show1 QualifiedImport where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable QualifiedImport where
   eval (QualifiedImport qualifiedName) = do
     modulePaths <- resolvePythonModules (QualifiedName qualifiedName)
-    rvalBox =<< go (NonEmpty.zip (name . T.pack <$> qualifiedName) modulePaths)
+    -- rvalBox =<< go (NonEmpty.zip (Data.Abstract.Evaluatable.name . T.pack <$> qualifiedName) modulePaths)
+    rvalBox unit
     where
-      -- Evaluate and import the last module, updating the environment
-      go ((name, path) :| []) = evalQualifiedImport name path
-      -- Evaluate each parent module, just creating a namespace
-      go ((name, path) :| xs) = letrec' name $ \addr -> do
-        void $ require path
-        makeNamespace name addr Nothing (void (require path >> go (NonEmpty.fromList xs)))
+      -- -- Evaluate and import the last module, updating the environment
+      -- go ((name, path) :| []) = evalQualifiedImport name path
+      -- -- Evaluate each parent module, just creating a namespace
+      -- go ((name, path) :| xs) = letrec' name $ \addr -> do
+      --   void $ require path
+      --   makeNamespace name addr Nothing (void (require path >> go (NonEmpty.fromList xs)))
 
 data QualifiedAliasedImport a = QualifiedAliasedImport { qualifiedAliasedImportFrom :: QualifiedName, qualifiedAliasedImportAlias :: !a }
   deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Message1, Named1, Ord, Show, ToJSONFields1, Traversable)
@@ -216,9 +214,10 @@ instance Evaluatable QualifiedAliasedImport where
 
     -- Evaluate and import the last module, aliasing and updating the environment
     alias <- maybeM (throwEvalError NoNameError) (declaredName (subterm aliasTerm))
-    rvalBox =<< letrec' alias (\addr -> do
-      let path = NonEmpty.last modulePaths
-      unit <$ makeNamespace alias addr Nothing (void (bindAll . fst . snd =<< require path)))
+    rvalBox unit
+    -- rvalBox =<< letrec' alias (\addr -> do
+    --   let path = NonEmpty.last modulePaths
+    --   unit <$ makeNamespace alias addr Nothing (void (bindAll . fst . snd =<< require path)))
 
 -- | Ellipsis (used in splice expressions and alternatively can be used as a fill in expression, like `undefined` in Haskell)
 data Ellipsis a = Ellipsis

src/Language/TypeScript/Resolution.hs

@@ -8,7 +8,7 @@ module Language.TypeScript.Resolution
   , resolveModule
   , resolveNonRelativePath
   , javascriptExtensions
-  , evalRequire
+  -- , evalRequire
   , typescriptExtensions
   ) where
 
@@ -164,15 +164,15 @@ typescriptExtensions = ["ts", "tsx", "d.ts"]
 javascriptExtensions :: [String]
 javascriptExtensions = ["js"]
 
-evalRequire :: ( AbstractValue address value effects
-               , Member (Allocator address) effects
-               , Member (Deref value) effects
-               , Member (Modules address value) effects
-               , Member (State (Heap address address value)) effects
-               , Ord address
-               )
-            => M.ModulePath
-            -> Name
-            -> Evaluator address value effects value
-evalRequire modulePath alias = letrec' alias $ \addr ->
-  unit <$ makeNamespace alias addr Nothing (bindAll . fst . snd =<< require modulePath)
+-- evalRequire :: ( AbstractValue address value effects
+--                , Member (Allocator address) effects
+--                , Member (Deref value) effects
+--                , Member (Modules address value) effects
+--                , Member (State (Heap address address value)) effects
+--                , Ord address
+--                )
+--             => M.ModulePath
+--             -> Name
+--             -> Evaluator address value effects value
+-- evalRequire modulePath alias = letrec' alias $ \addr ->
+--   unit <$ makeNamespace alias addr Nothing (bindAll . fst . snd =<< require modulePath)

src/Language/TypeScript/Syntax/JavaScript.hs

@@ -10,6 +10,9 @@ import           Data.Abstract.Evaluatable
 import           Data.JSON.Fields
 import           Diffing.Algorithm
 import           Language.TypeScript.Resolution
+import           Control.Abstract.ScopeGraph hiding (Import)
+import           qualified Data.Abstract.ScopeGraph as ScopeGraph
+import qualified Data.Map.Strict as Map
 
 data JavaScriptRequire a = JavaScriptRequire { javascriptRequireIden :: !a, javascriptRequireFrom :: ImportPath }
   deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Message1, Named1, Ord, Show, ToJSONFields1, Traversable)
@@ -21,8 +24,17 @@ instance Show1 JavaScriptRequire where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable JavaScriptRequire where
   eval (JavaScriptRequire aliasTerm importPath) = do
     modulePath <- resolveWithNodejsStrategy importPath javascriptExtensions
-    alias <- maybeM (throwEvalError NoNameError) (declaredName (subterm aliasTerm))
-    rvalBox =<< evalRequire modulePath alias
+    (scopeGraph, value) <- require modulePath
+    bindAll scopeGraph
+    case declaredName (subterm aliasTerm) of
+      Just alias -> do
+        span <- get @Span
+        void $ declare (Declaration alias) span (ScopeGraph.currentScope scopeGraph) -- TODO: declare shouldn't return a fake (Address address)
+      Nothing -> do
+        -- TODO: Throw a resumable exception if no current scope in imported scope graph.
+        -- Or better yet get rid of the Maybe in ScopeGraph { currentScope :: Maybe scope, ... }
+        maybe (pure ()) (insertEdge ScopeGraph.Import) (ScopeGraph.currentScope scopeGraph)
+    rvalBox unit
 
 data Debugger a = Debugger
   deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Message1, Named1, Ord, Show, ToJSONFields1, Traversable)

src/Language/TypeScript/Syntax/TypeScript.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE DeriveAnyClass, DuplicateRecordFields #-}
+{-# LANGUAGE DeriveAnyClass, DuplicateRecordFields, TupleSections #-}
 {-# OPTIONS_GHC -Wno-missing-export-lists #-}
 module Language.TypeScript.Syntax.TypeScript where
 
@@ -15,6 +15,8 @@ import           Data.JSON.Fields
 import           Diffing.Algorithm
 import           Language.TypeScript.Resolution
 import qualified Data.Map.Strict as Map
+import Data.Semigroup.App
+import Data.Semigroup.Foldable (foldMap1)
 
 data Import a = Import { importSymbols :: ![Alias], importFrom :: ImportPath }
   deriving (Declarations1, Diffable, Eq, Foldable, FreeVariables1, Functor, Generic1, Hashable1, Message1, Named1, Ord, Show, ToJSONFields1, Traversable)
@@ -116,11 +118,14 @@ instance Show1 QualifiedExportFrom where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable QualifiedExportFrom where
   eval (QualifiedExportFrom importPath exportSymbols) = do
     modulePath <- resolveWithNodejsStrategy importPath typescriptExtensions
-    importedBinds <- fst . snd <$> require modulePath
+    scopeGraph <- fst <$> require modulePath
     -- Look up addresses in importedEnv and insert the aliases with addresses into the exports.
     for_ exportSymbols $ \Alias{..} -> do
-      let address = Env.lookup aliasValue importedBinds
-      maybe (throwEvalError $ ExportError modulePath aliasValue) (export aliasValue aliasName . Just) address
+      -- TODO: Add an Alias Edge to resolve qualified export froms
+      -- Scope 1 -> alias (bar, foo) -> Export 3 -> Export -> Scope 4
+      pure ()
+      -- let address = Env.lookup aliasValue importedBinds
+      -- maybe (throwEvalError $ ExportError modulePath aliasValue) (export aliasValue aliasName . Just) address
     rvalBox unit
 
 newtype DefaultExport a = DefaultExport { defaultExport :: a }
@@ -133,10 +138,10 @@ instance Show1 DefaultExport where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable DefaultExport where
   eval (DefaultExport term) = do
     case declaredName term of
-      Just name -> do
-        addr <- subtermAddress term
-        export name name Nothing
-        bind name addr
+      Just name -> pure ()
+        -- addr <- subtermAddress term
+        -- export name name Nothing
+        -- bind name addr
       Nothing -> throwEvalError DefaultExportError
     rvalBox unit
 
@@ -530,9 +535,10 @@ instance Show1 Module where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Module where
   eval (Module iden xs) = do
-    name <- maybeM (throwEvalError NoNameError) (declaredName (subterm iden))
-    rvalBox =<< letrec' name (\addr ->
-      makeNamespace name addr Nothing (void (eval xs)))
+    currentScopeAddress <- currentScope
+    let edges = Map.singleton Lexical [ currentScopeAddress ]
+    scope <- newScope edges
+    withScope scope $ maybe (rvalBox unit) (runApp . foldMap1 (App . subtermRef)) (nonEmpty xs)
 
 
 data InternalModule a = InternalModule { internalModuleIdentifier :: !a, internalModuleStatements :: ![a] }
@@ -544,9 +550,10 @@ instance Show1 InternalModule where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable InternalModule where
   eval (InternalModule iden xs) = do
-    name <- maybeM (throwEvalError NoNameError) (declaredName (subterm iden))
-    rvalBox =<< letrec' name (\addr ->
-      makeNamespace name addr Nothing (void (eval xs)))
+    currentScopeAddress <- currentScope
+    let edges = Map.singleton Lexical [ currentScopeAddress ]
+    scope <- newScope edges
+    withScope scope $ maybe (rvalBox unit) (runApp . foldMap1 (App . subtermRef)) (nonEmpty xs)
 
 instance Declarations a => Declarations (InternalModule a) where
   declaredName InternalModule{..} = declaredName internalModuleIdentifier
@@ -580,9 +587,24 @@ instance Declarations a => Declarations (AbstractClass a) where
 instance Evaluatable AbstractClass where
   eval AbstractClass{..} = do
     name <- maybeM (throwEvalError NoNameError) (declaredName (subterm abstractClassIdentifier))
-    supers <- traverse subtermAddress classHeritage
-    (v, addr) <- letrec name $ do
+    span <- ask @Span
+    -- Run the action within the class's scope.
+    currentScopeAddress <- currentScope
+
+    supers <- for classHeritage $ \superclass -> do
+      name <- maybeM (throwEvalError NoNameError) (declaredName (subterm superclass))
+      scope <- associatedScope (Declaration name)
+      (scope,) <$> subtermValue superclass
+
+    let imports = (ScopeGraph.Import, ) <$> (pure . catMaybes $ fst <$> supers)
+        current = pure (Lexical, [ currentScopeAddress ])
+        edges = Map.fromList (imports <> current)
+    childScope <- newScope edges
+    declare (Declaration name) span (Just childScope)
+
+    frame <- newFrame childScope mempty -- TODO: Instantiate frames for superclasses
+    withScopeAndFrame frame $ do
       void $ subtermValue classBody
-      classBinds <- Env.head <$> getEnv
-      klass name supers classBinds
-    rvalBox =<< (v <$ bind name addr)
+      klass (Declaration name) (snd <$> supers) frame
+
+    rvalBox unit