Simplify calls to throwNoNameError

src/Data/Abstract/Evaluatable.hs

@@ -8,6 +8,7 @@ module Data.Abstract.Evaluatable
 -- * Effects
 , EvalError(..)
 , throwEvalError
+, throwNoNameError
 , runEvalError
 , runEvalErrorWith
 , UnspecializedError(..)
@@ -194,6 +195,15 @@ data EvalError term address value return where
   ReferenceError      :: value -> Name -> EvalError term address value (Slot address)
   ScopedEnvError      :: value -> EvalError term address value address
 
+throwNoNameError :: ( Carrier sig m
+                    , Member (Reader ModuleInfo) sig
+                    , Member (Reader Span) sig
+                    , Member (Resumable (BaseError (EvalError term address value))) sig
+                    )
+                => term
+                -> Evaluator term address value m Name
+throwNoNameError = throwEvalError . NoNameError
+
 deriving instance (Eq term, Eq value) => Eq (EvalError term address value return)
 deriving instance (Show term, Show value) => Show (EvalError term address value return)
 

src/Data/Syntax/Declaration.hs

@@ -30,12 +30,12 @@ instance Show1 Function where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Function where
   eval _ _ Function{..} = do
-    name <- maybeM (throwEvalError $ NoNameError functionName) (declaredName functionName)
+    name <- maybeM (throwNoNameError functionName) (declaredName functionName)
     span <- ask @Span
     associatedScope <- declareFunction name span
 
     params <- withScope associatedScope . for functionParameters $ \paramNode -> do
-      param <- maybeM (throwEvalError $ NoNameError paramNode) (declaredName paramNode)
+      param <- maybeM (throwNoNameError paramNode) (declaredName paramNode)
       param <$ declare (Declaration param) Default span Nothing
 
     addr <- lookupDeclaration (Declaration name)
@@ -86,7 +86,7 @@ instance Diffable Method where
 -- local environment.
 instance Evaluatable Method where
   eval _ _ Method{..} = do
-    name <- maybeM (throwEvalError $ NoNameError methodName) (declaredName methodName)
+    name <- maybeM (throwNoNameError methodName) (declaredName methodName)
     span <- ask @Span
     associatedScope <- declareFunction name span
 
@@ -94,7 +94,7 @@ instance Evaluatable Method where
       -- TODO: Should we give `self` a special Relation?
       declare (Declaration __self) Default emptySpan Nothing
       for methodParameters $ \paramNode -> do
-        param <- maybeM (throwEvalError $ NoNameError paramNode) (declaredName paramNode)
+        param <- maybeM (throwNoNameError paramNode) (declaredName paramNode)
         param <$ declare (Declaration param) Default span Nothing
 
     addr <- lookupDeclaration (Declaration name)
@@ -163,7 +163,7 @@ instance Evaluatable VariableDeclaration where
   eval _    _ (VariableDeclaration [])   = pure unit
   eval eval _ (VariableDeclaration decs) = do
     for_ decs $ \declaration -> do
-      name <- maybeM (throwEvalError $ NoNameError declaration) (declaredName declaration)
+      name <- maybeM (throwNoNameError declaration) (declaredName declaration)
       declare (Declaration name) Default emptySpan Nothing
       (span, _) <- do
         ref <- eval declaration
@@ -207,7 +207,7 @@ instance Show1 PublicFieldDefinition where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable PublicFieldDefinition where
   eval eval _ PublicFieldDefinition{..} = do
     span <- ask @Span
-    propertyName <- maybeM (throwEvalError $ NoNameError publicFieldPropertyName) (declaredName publicFieldPropertyName)
+    propertyName <- maybeM (throwNoNameError publicFieldPropertyName) (declaredName publicFieldPropertyName)
 
     declare (Declaration propertyName) Instance span Nothing
     slot <- lookupDeclaration (Declaration propertyName)
@@ -240,12 +240,12 @@ instance Show1 Class where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Class where
   eval eval _ Class{..} = do
-    name <- maybeM (throwEvalError $ NoNameError classIdentifier) (declaredName classIdentifier)
+    name <- maybeM (throwNoNameError classIdentifier) (declaredName classIdentifier)
     span <- ask @Span
     currentScope' <- currentScope
 
     superScopes <- for classSuperclasses $ \superclass -> do
-      name <- maybeM (throwEvalError $ NoNameError superclass) (declaredName superclass)
+      name <- maybeM (throwNoNameError superclass) (declaredName superclass)
       scope <- associatedScope (Declaration name)
       slot <- lookupDeclaration (Declaration name)
       superclassFrame <- scopedEnvironment =<< deref slot
@@ -345,8 +345,8 @@ instance Show1 TypeAlias where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable TypeAlias where
   eval _ _ TypeAlias{..} = do
-    name <- maybeM (throwEvalError $ NoNameError typeAliasIdentifier) (declaredName typeAliasIdentifier)
+    name <- maybeM (throwNoNameError typeAliasIdentifier) (declaredName typeAliasIdentifier)
-    kindName <- maybeM (throwEvalError $ NoNameError typeAliasKind) (declaredName typeAliasKind)
+    kindName <- maybeM (throwNoNameError typeAliasKind) (declaredName typeAliasKind)
 
     span <- ask @Span
     assocScope <- associatedScope (Declaration kindName)

src/Data/Syntax/Expression.hs

@@ -643,7 +643,7 @@ instance Show1 New where liftShowsPrec = genericLiftShowsPrec
 -- TODO: Implement Eval instance for New
 instance Evaluatable New where
   eval eval _ New{..} = do
-    name <- maybeM (throwEvalError $ NoNameError subject) (declaredName subject)
+    name <- maybeM (throwNoNameError subject) (declaredName subject)
     assocScope <- maybeM (throwEvalError $ ConstructorError name) =<< associatedScope (Declaration name)
     objectScope <- newScope (Map.singleton Superclass [ assocScope ])
     slot <- lookupDeclaration (Declaration name)
@@ -657,9 +657,10 @@ instance Evaluatable New where
     instanceMembers <- relationsOfScope classScope Instance
 
     void . withScopeAndFrame objectFrame $ do
-      for_ instanceMembers $ \Data{..} -> do
+      for_ instanceMembers $ \Info{..} -> do
         declare dataDeclaration Default dataSpan dataAssociatedScope
 
+      -- TODO: This is a typescript specific name and we should allow languages to customize it.
       let constructorName = Name.name "constructor"
       reference (Reference constructorName) (Declaration constructorName)
       constructor <- deref =<< lookupDeclaration (Declaration constructorName)

src/Data/Syntax/Statement.hs

@@ -145,9 +145,9 @@ instance Show1 Let where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Let where
   eval eval _ Let{..} = do
-    name <- maybeM (throwEvalError $ NoNameError letVariable) (declaredName letVariable)
+    name <- maybeM (throwNoNameError letVariable) (declaredName letVariable)
     letSpan <- ask @Span
-    valueName <- maybeM (throwEvalError $ NoNameError letValue) (declaredName letValue)
+    valueName <- maybeM (throwNoNameError letValue) (declaredName letValue)
     assocScope <- associatedScope (Declaration valueName)
 
     _ <- withLexicalScopeAndFrame $ do

src/Language/Go/Syntax.hs

@@ -82,7 +82,7 @@ instance Show1 QualifiedImport where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable QualifiedImport where
   eval _ _ (QualifiedImport importPath aliasTerm) = do
     paths <- resolveGoImport importPath
-    alias <- maybeM (throwEvalError $ NoNameError aliasTerm) (declaredName aliasTerm)
+    alias <- maybeM (throwNoNameError aliasTerm) (declaredName aliasTerm)
     span <- ask @Span
     scopeAddress <- newScope mempty
     declare (Declaration alias) Default span (Just scopeAddress)

src/Language/PHP/Syntax.hs

@@ -218,11 +218,11 @@ instance Show1 QualifiedName where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable QualifiedName where
   eval _ _ (QualifiedName obj iden) = do
-    name <- maybeM (throwEvalError $ NoNameError obj) (declaredName obj)
+    name <- maybeM (throwNoNameError obj) (declaredName obj)
     reference (Reference name) (Declaration name)
     childScope <- associatedScope (Declaration name)
 
-    propName <- maybeM (throwEvalError $ NoNameError iden) (declaredName iden)
+    propName <- maybeM (throwNoNameError iden) (declaredName iden)
     case childScope of
       Just childScope -> do
         currentScopeAddress <- currentScope

src/Language/Python/Syntax.hs

@@ -254,7 +254,7 @@ instance Evaluatable QualifiedAliasedImport where
 
     span <- ask @Span
     scopeAddress <- newScope mempty
-    alias <- maybeM (throwEvalError $ NoNameError aliasTerm) (declaredName aliasTerm)
+    alias <- maybeM (throwNoNameError aliasTerm) (declaredName aliasTerm)
     declare (Declaration alias) Default span (Just scopeAddress)
     objFrame <- newFrame scopeAddress mempty
     val <- object objFrame

src/Language/Ruby/Syntax.hs

@@ -72,7 +72,7 @@ instance Show1 Send where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable Send where
   eval eval _ Send{..} = do
     sel <- case sendSelector of
-             Just sel -> maybeM (throwEvalError $ NoNameError sel) (declaredName sel)
+             Just sel -> maybeM (throwNoNameError sel) (declaredName sel)
              Nothing  ->
                pure (Name.name "call")
 
@@ -193,7 +193,7 @@ instance Show1 Class where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Class where
   eval eval _ Class{..} = do
-    name <- maybeM (throwEvalError $ NoNameError classIdentifier) (declaredName classIdentifier)
+    name <- maybeM (throwNoNameError classIdentifier) (declaredName classIdentifier)
     span <- ask @Span
     currentScope' <- currentScope
 
@@ -210,7 +210,7 @@ instance Evaluatable Class where
       Nothing -> do
         let classSuperclasses = maybeToList classSuperClass
         superScopes <- for classSuperclasses $ \superclass -> do
-          name <- maybeM (throwEvalError $ NoNameError superclass) (declaredName superclass)
+          name <- maybeM (throwNoNameError superclass) (declaredName superclass)
           scope <- associatedScope (Declaration name)
           slot <- lookupDeclaration (Declaration name)
           superclassFrame <- scopedEnvironment =<< deref slot
@@ -256,7 +256,7 @@ instance Show1 Module where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Module where
   eval eval _ Module{..} =  do
-    name <- maybeM (throwEvalError $ NoNameError moduleIdentifier) (declaredName moduleIdentifier)
+    name <- maybeM (throwNoNameError moduleIdentifier) (declaredName moduleIdentifier)
     span <- ask @Span
     currentScope' <- currentScope
 
@@ -348,7 +348,7 @@ instance Show1 Assignment where liftShowsPrec = genericLiftShowsPrec
 
 instance Evaluatable Assignment where
   eval eval ref Assignment{..} = do
-    lhsName <- maybeM (throwEvalError $ NoNameError assignmentTarget) (declaredName assignmentTarget)
+    lhsName <- maybeM (throwNoNameError assignmentTarget) (declaredName assignmentTarget)
     maybeSlot <- maybeLookupDeclaration (Declaration lhsName)
     assignmentSpan <- ask @Span
     maybe (declare (Declaration lhsName) Default assignmentSpan Nothing) (const (pure ())) maybeSlot

src/Language/TypeScript/Syntax/JSX.hs

@@ -96,7 +96,7 @@ instance Ord1 RequiredParameter where liftCompare = genericLiftCompare
 instance Show1 RequiredParameter where liftShowsPrec = genericLiftShowsPrec
 instance Evaluatable RequiredParameter where
   eval eval ref RequiredParameter{..} = do
-    name <- maybeM (throwEvalError $ NoNameError requiredParameterSubject) (declaredName requiredParameterSubject)
+    name <- maybeM (throwNoNameError requiredParameterSubject) (declaredName requiredParameterSubject)
     span <- ask @Span
     declare (Declaration name) Default span Nothing
 

src/Language/TypeScript/Syntax/TypeScript.hs

@@ -67,7 +67,7 @@ instance Evaluatable QualifiedAliasedImport where
     let scopeMap = Map.singleton moduleScope moduleFrame
     aliasFrame <- newFrame importScope (Map.singleton ScopeGraph.Import scopeMap)
 
-    alias <- maybeM (throwEvalError $ NoNameError aliasTerm) (declaredName aliasTerm)
+    alias <- maybeM (throwNoNameError aliasTerm) (declaredName aliasTerm)
     declare (Declaration alias) Default span (Just importScope)
     aliasSlot <- lookupDeclaration (Declaration alias)
     assign aliasSlot =<< object aliasFrame
@@ -579,7 +579,7 @@ declareModule :: ( AbstractValue term address value m
                 -> [term]
                 -> Evaluator term address value m value
 declareModule eval identifier statements = do
-    name <- maybeM (throwEvalError $ NoNameError identifier) (declaredName identifier)
+    name <- maybeM (throwNoNameError identifier) (declaredName identifier)
     span <- ask @Span
     currentScope' <- currentScope
 
@@ -659,12 +659,12 @@ instance Declarations a => Declarations (AbstractClass a) where
 
 instance Evaluatable AbstractClass where
   eval eval _ AbstractClass{..} = do
-    name <- maybeM (throwEvalError $ NoNameError abstractClassIdentifier) (declaredName abstractClassIdentifier)
+    name <- maybeM (throwNoNameError abstractClassIdentifier) (declaredName abstractClassIdentifier)
     span <- ask @Span
     currentScope' <- currentScope
 
     superScopes <- for classHeritage $ \superclass -> do
-      name <- maybeM (throwEvalError $ NoNameError superclass) (declaredName superclass)
+      name <- maybeM (throwNoNameError superclass) (declaredName superclass)
       scope <- associatedScope (Declaration name)
       slot <- lookupDeclaration (Declaration name)
       superclassFrame <- scopedEnvironment =<< deref slot