From 269476aa34d89ef0e4e4a7054ccf4c63412b2ea5 Mon Sep 17 00:00:00 2001 From: joshvera Date: Fri, 14 Dec 2018 17:15:47 -0500 Subject: [PATCH] Simplify calls to throwNoNameError --- src/Data/Abstract/Evaluatable.hs | 10 ++++++++++ src/Data/Syntax/Declaration.hs | 20 ++++++++++---------- src/Data/Syntax/Expression.hs | 5 +++-- src/Data/Syntax/Statement.hs | 4 ++-- src/Language/Go/Syntax.hs | 2 +- src/Language/PHP/Syntax.hs | 4 ++-- src/Language/Python/Syntax.hs | 2 +- src/Language/Ruby/Syntax.hs | 10 +++++----- src/Language/TypeScript/Syntax/JSX.hs | 2 +- src/Language/TypeScript/Syntax/TypeScript.hs | 8 ++++---- 10 files changed, 39 insertions(+), 28 deletions(-) diff --git a/src/Data/Abstract/Evaluatable.hs b/src/Data/Abstract/Evaluatable.hs index 5a480e72a..3d9794fb8 100644 --- a/src/Data/Abstract/Evaluatable.hs +++ b/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) diff --git a/src/Data/Syntax/Declaration.hs b/src/Data/Syntax/Declaration.hs index b81712949..ce2d287ef 100644 --- a/src/Data/Syntax/Declaration.hs +++ b/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) - kindName <- maybeM (throwEvalError $ NoNameError typeAliasKind) (declaredName typeAliasKind) + name <- maybeM (throwNoNameError typeAliasIdentifier) (declaredName typeAliasIdentifier) + kindName <- maybeM (throwNoNameError typeAliasKind) (declaredName typeAliasKind) span <- ask @Span assocScope <- associatedScope (Declaration kindName) diff --git a/src/Data/Syntax/Expression.hs b/src/Data/Syntax/Expression.hs index 702e1805a..d1c92752c 100644 --- a/src/Data/Syntax/Expression.hs +++ b/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) diff --git a/src/Data/Syntax/Statement.hs b/src/Data/Syntax/Statement.hs index 8cd7582c0..6a6e65765 100644 --- a/src/Data/Syntax/Statement.hs +++ b/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 diff --git a/src/Language/Go/Syntax.hs b/src/Language/Go/Syntax.hs index a3c0c264f..68dff683a 100644 --- a/src/Language/Go/Syntax.hs +++ b/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) diff --git a/src/Language/PHP/Syntax.hs b/src/Language/PHP/Syntax.hs index 31a94a4d1..daaae79ca 100644 --- a/src/Language/PHP/Syntax.hs +++ b/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 diff --git a/src/Language/Python/Syntax.hs b/src/Language/Python/Syntax.hs index 02d5d9122..9577b44d7 100644 --- a/src/Language/Python/Syntax.hs +++ b/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 diff --git a/src/Language/Ruby/Syntax.hs b/src/Language/Ruby/Syntax.hs index 7b30643b9..ff6b7fd78 100644 --- a/src/Language/Ruby/Syntax.hs +++ b/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 diff --git a/src/Language/TypeScript/Syntax/JSX.hs b/src/Language/TypeScript/Syntax/JSX.hs index d3537ee6c..9ac784527 100644 --- a/src/Language/TypeScript/Syntax/JSX.hs +++ b/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 diff --git a/src/Language/TypeScript/Syntax/TypeScript.hs b/src/Language/TypeScript/Syntax/TypeScript.hs index ee98d716b..4134e30ae 100644 --- a/src/Language/TypeScript/Syntax/TypeScript.hs +++ b/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