From 73bbc66a2fadcba99a10ae4783357d3a10d8f368 Mon Sep 17 00:00:00 2001 From: Rick Winfrey Date: Mon, 4 Mar 2019 12:51:33 -0800 Subject: [PATCH] Update ScopeGraph.Kind naming to avoid confusion This helps us disambiguate between syntax terms and scope graph kinds --- src/Control/Abstract/Heap.hs | 2 +- src/Control/Abstract/Primitive.hs | 4 +-- src/Data/Abstract/Evaluatable.hs | 4 +-- src/Data/Abstract/ScopeGraph.hs | 27 ++++++++++++++++++-- src/Data/Syntax.hs | 2 +- src/Data/Syntax/Declaration.hs | 20 +++++++-------- src/Data/Syntax/Expression.hs | 4 +-- src/Data/Syntax/Statement.hs | 2 +- src/Language/Go/Syntax.hs | 2 +- src/Language/PHP/Syntax.hs | 4 +-- src/Language/Python/Syntax.hs | 8 +++--- src/Language/Ruby/Syntax.hs | 8 +++--- src/Language/TypeScript/Syntax/Import.hs | 10 ++++---- src/Language/TypeScript/Syntax/JSX.hs | 2 +- src/Language/TypeScript/Syntax/JavaScript.hs | 2 +- src/Language/TypeScript/Syntax/TypeScript.hs | 4 +-- src/Language/TypeScript/Syntax/Types.hs | 2 +- 17 files changed, 65 insertions(+), 42 deletions(-) diff --git a/src/Control/Abstract/Heap.hs b/src/Control/Abstract/Heap.hs index 7ec6ab8f0..f28b47590 100644 --- a/src/Control/Abstract/Heap.hs +++ b/src/Control/Abstract/Heap.hs @@ -181,7 +181,7 @@ define :: ( HasCallStack -> Evaluator term address value m () define declaration rel accessControl def = withCurrentCallStack callStack $ do -- TODO: This span is still wrong. - declare declaration rel accessControl emptySpan Unknown Nothing + declare declaration rel accessControl emptySpan UnknownKind Nothing slot <- lookupSlot declaration value <- def assign slot value diff --git a/src/Control/Abstract/Primitive.hs b/src/Control/Abstract/Primitive.hs index 4880c787f..c47118b6e 100644 --- a/src/Control/Abstract/Primitive.hs +++ b/src/Control/Abstract/Primitive.hs @@ -43,11 +43,11 @@ defineBuiltIn declaration rel accessControl value = withCurrentCallStack callSta let lexicalEdges = Map.singleton Lexical [ currentScope' ] associatedScope <- newPreludeScope lexicalEdges -- TODO: This span is still wrong. - declare declaration rel accessControl emptySpan ScopeGraph.Unknown (Just associatedScope) + declare declaration rel accessControl emptySpan ScopeGraph.UnknownKind (Just associatedScope) param <- gensym withScope associatedScope $ do - declare (Declaration param) rel accessControl emptySpan ScopeGraph.Unknown Nothing + declare (Declaration param) rel accessControl emptySpan ScopeGraph.UnknownKind Nothing slot <- lookupSlot declaration value <- builtIn associatedScope value diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 1b885754a..34dff10d8 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/src/Data/Abstract/Evaluatable.hs @@ -30,7 +30,7 @@ import Data.Abstract.Declarations as X import Data.Abstract.FreeVariables as X import Data.Abstract.Module import Data.Abstract.Name as X -import qualified Data.Abstract.ScopeGraph as ScopeGraph +import qualified Data.Abstract.ScopeGraph as ScopeGraph import Data.Abstract.ScopeGraph (Relation(..)) import Data.Abstract.AccessControls.Class as X import Data.Language @@ -192,7 +192,7 @@ defineSelf :: ( Carrier sig m => Evaluator term address value m () defineSelf = do let self = Declaration X.__self - declare self Default Public emptySpan ScopeGraph.Unknown Nothing + declare self Default Public emptySpan ScopeGraph.UnknownKind Nothing slot <- lookupSlot self assign slot =<< object =<< currentFrame diff --git a/src/Data/Abstract/ScopeGraph.hs b/src/Data/Abstract/ScopeGraph.hs index 950a14d12..ee72a7c4a 100644 --- a/src/Data/Abstract/ScopeGraph.hs +++ b/src/Data/Abstract/ScopeGraph.hs @@ -119,11 +119,34 @@ instance HasSpan ReferenceInfo where span = lens refSpan (\r s -> r { refSpan = s }) {-# INLINE span #-} -data Kind = TypeAlias | Class | Method | QualifiedAliasedImport | QualifiedExport | DefaultExport | Module | AbstractClass | Let | QualifiedImport | UnqualifiedImport | Assignment | RequiredParameter | PublicField | VariableDeclaration | Function | Parameter | Unknown | Identifier | TypeIdentifier | This | New | MemberAccess | Call +data Kind = AbstractClassKind + | AssignmentKind + | CallKind + | ClassKind + | DefaultExportKind + | FunctionKind + | IdentifierKind + | LetKind + | MemberAccessKind + | MethodKind + | ModuleKind + | NewKind + | ParameterKind + | PublicFieldKind + | QualifiedAliasedImportKind + | QualifiedExportKind + | QualifiedImportKind + | RequiredParameterKind + | ThisKind + | TypeAliasKind + | TypeIdentifierKind + | UnknownKind + | UnqualifiedImportKind + | VariableDeclarationKind deriving (Eq, Show, Ord, Generic, NFData) instance Lower Kind where - lowerBound = Unknown + lowerBound = UnknownKind -- Offsets and frame addresses in the heap should be addresses? data Scope address = diff --git a/src/Data/Syntax.hs b/src/Data/Syntax.hs index 3aecf713a..cb8b94306 100644 --- a/src/Data/Syntax.hs +++ b/src/Data/Syntax.hs @@ -126,7 +126,7 @@ instance Evaluatable Identifier where eval eval ref' term@(Identifier name) = do -- TODO: Set the span up correctly in ref so we can move the `reference` call there. span <- ask @Span - reference (Reference name) span ScopeGraph.Identifier (Declaration name) + reference (Reference name) span ScopeGraph.IdentifierKind (Declaration name) deref =<< ref eval ref' term ref _ _ (Identifier name) = lookupSlot (Declaration name) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index 257a50de0..b9dce71d3 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/src/Data/Syntax/Declaration.hs @@ -30,13 +30,13 @@ instance Evaluatable Function where eval _ _ Function{..} = do name <- maybeM (throwNoNameError functionName) (declaredName functionName) span <- ask @Span - associatedScope <- declareFunction name ScopeGraph.Public span ScopeGraph.Function + associatedScope <- declareFunction name ScopeGraph.Public span ScopeGraph.FunctionKind params <- withScope associatedScope . for functionParameters $ \paramNode -> do param <- maybeM (throwNoNameError paramNode) (declaredName paramNode) let paramSpan = getSpan paramNode - param <$ declare (Declaration param) Default ScopeGraph.Public paramSpan ScopeGraph.Parameter Nothing + param <$ declare (Declaration param) Default ScopeGraph.Public paramSpan ScopeGraph.ParameterKind Nothing addr <- lookupSlot (Declaration name) v <- function name params functionBody associatedScope @@ -94,14 +94,14 @@ instance Evaluatable Method where eval _ _ Method{..} = do name <- maybeM (throwNoNameError methodName) (declaredName methodName) span <- ask @Span - associatedScope <- declareFunction name methodAccessControl span ScopeGraph.Method + associatedScope <- declareFunction name methodAccessControl span ScopeGraph.MethodKind params <- withScope associatedScope $ do -- TODO: Should we give `self` a special Relation? - declare (Declaration __self) Prelude ScopeGraph.Public emptySpan ScopeGraph.Unknown Nothing + declare (Declaration __self) Prelude ScopeGraph.Public emptySpan ScopeGraph.UnknownKind Nothing for methodParameters $ \paramNode -> do param <- maybeM (throwNoNameError paramNode) (declaredName paramNode) - param <$ declare (Declaration param) Default ScopeGraph.Public span ScopeGraph.Parameter Nothing + param <$ declare (Declaration param) Default ScopeGraph.Public span ScopeGraph.ParameterKind Nothing addr <- lookupSlot (Declaration name) v <- function name params methodBody associatedScope @@ -146,7 +146,7 @@ instance Evaluatable RequiredParameter where eval _ _ RequiredParameter{..} = do name <- maybeM (throwNoNameError requiredParameter) (declaredName requiredParameter) span <- ask @Span - declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.RequiredParameter Nothing + declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.RequiredParameterKind Nothing unit @@ -172,7 +172,7 @@ instance Evaluatable VariableDeclaration where for_ decs $ \declaration -> do name <- maybeM (throwNoNameError declaration) (declaredName declaration) let declarationSpan = getSpan declaration - declare (Declaration name) Default ScopeGraph.Public declarationSpan ScopeGraph.VariableDeclaration Nothing + declare (Declaration name) Default ScopeGraph.Public declarationSpan ScopeGraph.VariableDeclarationKind Nothing eval declaration unit @@ -211,7 +211,7 @@ instance Evaluatable PublicFieldDefinition where span <- ask @Span propertyName <- maybeM (throwNoNameError publicFieldPropertyName) (declaredName publicFieldPropertyName) - declare (Declaration propertyName) Instance publicFieldAccessControl span ScopeGraph.PublicField Nothing + declare (Declaration propertyName) Instance publicFieldAccessControl span ScopeGraph.PublicFieldKind Nothing slot <- lookupSlot (Declaration propertyName) value <- eval publicFieldValue assign slot value @@ -253,7 +253,7 @@ instance Evaluatable Class where current = (Lexical, ) <$> pure (pure currentScope') edges = Map.fromList (superclassEdges <> current) classScope <- newScope edges - declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.Class (Just classScope) + declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.ClassKind (Just classScope) let frameEdges = Map.singleton Superclass (Map.fromList (catMaybes superScopes)) classFrame <- newFrame classScope frameEdges @@ -329,7 +329,7 @@ instance Evaluatable TypeAlias where span <- ask @Span assocScope <- associatedScope (Declaration kindName) -- TODO: Should we consider a special Relation for `TypeAlias`? - declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.TypeAlias assocScope + declare (Declaration name) Default ScopeGraph.Public span ScopeGraph.TypeAliasKind assocScope slot <- lookupSlot (Declaration name) kindSlot <- lookupSlot (Declaration kindName) diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index 888143b3f..18a579ea6 100644 --- a/src/Data/Syntax/Expression.hs +++ b/src/Data/Syntax/Expression.hs @@ -561,7 +561,7 @@ instance Evaluatable New where case maybeConstructor of Just slot -> do span <- ask @Span - reference (Reference constructorName) span ScopeGraph.New (Declaration constructorName) + reference (Reference constructorName) span ScopeGraph.NewKind (Declaration constructorName) constructor <- deref slot args <- traverse eval newArguments boundConstructor <- bindThis objectVal constructor @@ -596,7 +596,7 @@ instance Tokenize This where instance Evaluatable This where eval _ _ This = do span <- ask @Span - reference (Reference __self) span ScopeGraph.This (Declaration __self) + reference (Reference __self) span ScopeGraph.ThisKind (Declaration __self) deref =<< lookupSlot (Declaration __self) instance AccessControls1 This where diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index 9477058e2..1a2768d1a 100644 --- a/src/Data/Syntax/Statement.hs +++ b/src/Data/Syntax/Statement.hs @@ -127,7 +127,7 @@ instance Evaluatable Let where assocScope <- associatedScope (Declaration valueName) _ <- withLexicalScopeAndFrame $ do - declare (Declaration name) Default Public letSpan ScopeGraph.Let assocScope + declare (Declaration name) Default Public letSpan ScopeGraph.LetKind assocScope letVal <- eval letValue slot <- lookupSlot (Declaration name) assign slot letVal diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index 781b905b0..e489d94ea 100644 --- a/src/Language/Go/Syntax.hs +++ b/src/Language/Go/Syntax.hs @@ -78,7 +78,7 @@ instance Evaluatable QualifiedImport where alias <- maybeM (throwNoNameError aliasTerm) (declaredName aliasTerm) span <- ask @Span scopeAddress <- newScope mempty - declare (Declaration alias) Default Public span ScopeGraph.QualifiedImport (Just scopeAddress) + declare (Declaration alias) Default Public span ScopeGraph.QualifiedImportKind (Just scopeAddress) aliasSlot <- lookupSlot (Declaration alias) withScope scopeAddress $ do diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 2054ce073..34a42ffdc 100644 --- a/src/Language/PHP/Syntax.hs +++ b/src/Language/PHP/Syntax.hs @@ -174,7 +174,7 @@ instance Evaluatable QualifiedName where eval _ _ (QualifiedName obj iden) = do name <- maybeM (throwNoNameError obj) (declaredName obj) let objSpan = getSpan obj - reference (Reference name) objSpan ScopeGraph.Identifier (Declaration name) + reference (Reference name) objSpan ScopeGraph.IdentifierKind (Declaration name) childScope <- associatedScope (Declaration name) propName <- maybeM (throwNoNameError iden) (declaredName iden) @@ -185,7 +185,7 @@ instance Evaluatable QualifiedName where frameAddress <- newFrame childScope (Map.singleton Lexical (Map.singleton currentScopeAddress currentFrameAddress)) withScopeAndFrame frameAddress $ do let propSpan = getSpan iden - reference (Reference propName) propSpan ScopeGraph.Identifier (Declaration propName) + reference (Reference propName) propSpan ScopeGraph.IdentifierKind (Declaration propName) slot <- lookupSlot (Declaration propName) deref slot Nothing -> diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index eaa055226..b41b3807d 100644 --- a/src/Language/Python/Syntax.hs +++ b/src/Language/Python/Syntax.hs @@ -133,7 +133,7 @@ instance Evaluatable Import where -- Add declaration of the alias name to the current scope (within our current module). aliasName <- maybeM (throwNoNameError aliasTerm) (declaredAlias aliasTerm) let aliasSpan = getSpan aliasTerm - declare (Declaration aliasName) Default Public aliasSpan ScopeGraph.UnqualifiedImport (Just importScope) + declare (Declaration aliasName) Default Public aliasSpan ScopeGraph.UnqualifiedImportKind (Just importScope) -- Retrieve the frame slot for the new declaration. aliasSlot <- lookupSlot (Declaration aliasName) assign aliasSlot =<< object aliasFrame @@ -172,7 +172,7 @@ instance Evaluatable Import where aliasValue <- maybeM (throwNoNameError aliasTerm) (declaredName aliasTerm) if aliasValue /= aliasName then do let aliasSpan = getSpan aliasTerm - insertImportReference (Reference aliasName) aliasSpan ScopeGraph.Identifier (Declaration aliasValue) scopeAddress + insertImportReference (Reference aliasName) aliasSpan ScopeGraph.IdentifierKind (Declaration aliasValue) scopeAddress else pure () @@ -198,7 +198,7 @@ instance Evaluatable QualifiedImport where go (((nameTerm, name), modulePath) : namesAndPaths) = do scopeAddress <- newScope mempty let nameSpan = getSpan nameTerm - declare (Declaration name) Default Public nameSpan ScopeGraph.QualifiedImport (Just scopeAddress) + declare (Declaration name) Default Public nameSpan ScopeGraph.QualifiedImportKind (Just scopeAddress) aliasSlot <- lookupSlot (Declaration name) -- a.b.c withScope scopeAddress $ @@ -231,7 +231,7 @@ instance Evaluatable QualifiedAliasedImport where span <- ask @Span scopeAddress <- newScope mempty alias <- maybeM (throwNoNameError aliasTerm) (declaredName aliasTerm) - declare (Declaration alias) Default Public span ScopeGraph.QualifiedAliasedImport (Just scopeAddress) + declare (Declaration alias) Default Public span ScopeGraph.QualifiedAliasedImportKind (Just scopeAddress) objFrame <- newFrame scopeAddress mempty val <- object objFrame aliasSlot <- lookupSlot (Declaration alias) diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index f11fb9988..85f0768cf 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/src/Language/Ruby/Syntax.hs @@ -78,7 +78,7 @@ instance Evaluatable Send where let callFunction = do span <- ask @Span - reference (Reference sel) span ScopeGraph.Call (Declaration sel) + reference (Reference sel) span ScopeGraph.CallKind (Declaration sel) func <- deref =<< lookupSlot (Declaration sel) args <- traverse eval sendArgs boundFunc <- bindThis lhsValue func @@ -210,7 +210,7 @@ instance Evaluatable Class where current = (Lexical, ) <$> pure (pure currentScope') edges = Map.fromList (superclassEdges <> current) classScope <- newScope edges - declare (Declaration name) Default Public span ScopeGraph.Class (Just classScope) + declare (Declaration name) Default Public span ScopeGraph.ClassKind (Just classScope) let frameEdges = Map.singleton Superclass (Map.fromList (catMaybes superScopes)) childFrame <- newFrame classScope frameEdges @@ -260,7 +260,7 @@ instance Evaluatable Module where Nothing -> do let edges = Map.singleton Lexical [ currentScope' ] classScope <- newScope edges - declare (Declaration name) Default Public span ScopeGraph.Module (Just classScope) + declare (Declaration name) Default Public span ScopeGraph.ModuleKind (Just classScope) currentFrame' <- currentFrame let frameEdges = Map.singleton Lexical (Map.singleton currentScope' currentFrame') @@ -326,7 +326,7 @@ instance Evaluatable Assignment where lhsName <- maybeM (throwNoNameError assignmentTarget) (declaredName assignmentTarget) maybeSlot <- maybeLookupDeclaration (Declaration lhsName) assignmentSpan <- ask @Span - maybe (declare (Declaration lhsName) Default Public assignmentSpan ScopeGraph.Assignment Nothing) (const (pure ())) maybeSlot + maybe (declare (Declaration lhsName) Default Public assignmentSpan ScopeGraph.AssignmentKind Nothing) (const (pure ())) maybeSlot lhs <- ref assignmentTarget rhs <- eval assignmentValue diff --git a/src/Language/TypeScript/Syntax/Import.hs b/src/Language/TypeScript/Syntax/Import.hs index ad07c520f..46c0b9d88 100644 --- a/src/Language/TypeScript/Syntax/Import.hs +++ b/src/Language/TypeScript/Syntax/Import.hs @@ -38,7 +38,7 @@ instance Evaluatable Import where for_ symbols $ \Alias{..} -> -- TODO: Need an easier way to get the span of an Alias. It's difficult because we no longer have a term. -- Even if we had one we'd have to evaluate it at the moment. - insertImportReference (Reference aliasName) emptySpan ScopeGraph.Identifier (Declaration aliasValue) scopeAddress + insertImportReference (Reference aliasName) emptySpan ScopeGraph.IdentifierKind (Declaration aliasValue) scopeAddress -- Create edges from the current scope/frame to the import scope/frame. insertImportEdge scopeAddress @@ -60,7 +60,7 @@ instance Evaluatable QualifiedAliasedImport where aliasFrame <- newFrame importScope (Map.singleton ScopeGraph.Import scopeMap) alias <- maybeM (throwNoNameError aliasTerm) (declaredName aliasTerm) - declare (Declaration alias) Default Public span ScopeGraph.QualifiedAliasedImport (Just importScope) + declare (Declaration alias) Default Public span ScopeGraph.QualifiedAliasedImportKind (Just importScope) aliasSlot <- lookupSlot (Declaration alias) assign aliasSlot =<< object aliasFrame @@ -91,7 +91,7 @@ instance Evaluatable QualifiedExport where withScope exportScope . for_ exportSymbols $ \Alias{..} -> do -- TODO: Replace Alias in QualifedExport with terms and use a real span - reference (Reference aliasName) emptySpan ScopeGraph.Identifier (Declaration aliasValue) + reference (Reference aliasName) emptySpan ScopeGraph.IdentifierKind (Declaration aliasValue) -- Create an export edge from a new scope to the qualifed export's scope. unit @@ -118,7 +118,7 @@ instance Evaluatable QualifiedExportFrom where withScopeAndFrame moduleFrame . for_ exportSymbols $ \Alias{..} -> do -- TODO: Replace Alias with terms in QualifiedExportFrom and use a real span below. - insertImportReference (Reference aliasName) emptySpan ScopeGraph.Identifier (Declaration aliasValue) exportScope + insertImportReference (Reference aliasName) emptySpan ScopeGraph.IdentifierKind (Declaration aliasValue) exportScope insertExportEdge exportScope insertFrameLink ScopeGraph.Export (Map.singleton exportScope exportFrame) @@ -139,7 +139,7 @@ instance Evaluatable DefaultExport where withScopeAndFrame exportFrame $ do valueRef <- eval term let declaration = Declaration $ Name.name "__default" - declare declaration Default Public exportSpan ScopeGraph.DefaultExport Nothing + declare declaration Default Public exportSpan ScopeGraph.DefaultExportKind Nothing defaultSlot <- lookupSlot declaration assign defaultSlot valueRef diff --git a/src/Language/TypeScript/Syntax/JSX.hs b/src/Language/TypeScript/Syntax/JSX.hs index dd93c33f9..299cc6da2 100644 --- a/src/Language/TypeScript/Syntax/JSX.hs +++ b/src/Language/TypeScript/Syntax/JSX.hs @@ -78,7 +78,7 @@ instance Evaluatable RequiredParameter where eval eval ref RequiredParameter{..} = do name <- maybeM (throwNoNameError requiredParameterSubject) (declaredName requiredParameterSubject) span <- ask @Span - declare (Declaration name) Default Public span ScopeGraph.RequiredParameter Nothing + declare (Declaration name) Default Public span ScopeGraph.RequiredParameterKind Nothing lhs <- ref requiredParameterSubject rhs <- eval requiredParameterValue diff --git a/src/Language/TypeScript/Syntax/JavaScript.hs b/src/Language/TypeScript/Syntax/JavaScript.hs index 95d10e2c8..29f195ddc 100644 --- a/src/Language/TypeScript/Syntax/JavaScript.hs +++ b/src/Language/TypeScript/Syntax/JavaScript.hs @@ -26,7 +26,7 @@ instance Evaluatable JavaScriptRequire where Just alias -> do span <- ask @Span importScope <- newScope (Map.singleton ScopeGraph.Import [ moduleScope ]) - declare (Declaration alias) Default Public span ScopeGraph.UnqualifiedImport (Just importScope) + declare (Declaration alias) Default Public span ScopeGraph.UnqualifiedImportKind (Just importScope) let scopeMap = Map.singleton moduleScope moduleFrame aliasFrame <- newFrame importScope (Map.singleton ScopeGraph.Import scopeMap) aliasSlot <- lookupSlot (Declaration alias) diff --git a/src/Language/TypeScript/Syntax/TypeScript.hs b/src/Language/TypeScript/Syntax/TypeScript.hs index 272acbf4b..64a902918 100644 --- a/src/Language/TypeScript/Syntax/TypeScript.hs +++ b/src/Language/TypeScript/Syntax/TypeScript.hs @@ -212,7 +212,7 @@ declareModule eval identifier statements = do Nothing -> do let edges = Map.singleton Lexical [ currentScope' ] childScope <- newScope edges - declare (Declaration name) Default Public span ScopeGraph.Module (Just childScope) + declare (Declaration name) Default Public span ScopeGraph.ModuleKind (Just childScope) currentFrame' <- currentFrame let frameEdges = Map.singleton Lexical (Map.singleton currentScope' currentFrame') @@ -274,7 +274,7 @@ instance Evaluatable AbstractClass where current = (Lexical, ) <$> pure (pure currentScope') edges = Map.fromList (superclassEdges <> current) classScope <- newScope edges - declare (Declaration name) Default Public span ScopeGraph.AbstractClass (Just classScope) + declare (Declaration name) Default Public span ScopeGraph.AbstractClassKind (Just classScope) let frameEdges = Map.singleton Superclass (Map.fromList (catMaybes superScopes)) childFrame <- newFrame classScope frameEdges diff --git a/src/Language/TypeScript/Syntax/Types.hs b/src/Language/TypeScript/Syntax/Types.hs index 93f2440c8..44a391027 100644 --- a/src/Language/TypeScript/Syntax/Types.hs +++ b/src/Language/TypeScript/Syntax/Types.hs @@ -67,7 +67,7 @@ instance Evaluatable TypeIdentifier where eval _ _ TypeIdentifier{..} = do -- Add a reference to the type identifier in the current scope. span <- ask @Span - reference (Reference (Evaluatable.name contents)) span ScopeGraph.TypeIdentifier (Declaration (Evaluatable.name contents)) + reference (Reference (Evaluatable.name contents)) span ScopeGraph.TypeIdentifierKind (Declaration (Evaluatable.name contents)) unit data NestedTypeIdentifier a = NestedTypeIdentifier { left :: !a, right :: !a }