Commit ce797d03 authored by Niels Bunkenburg's avatar Niels Bunkenburg

Add infix operators to Undefined Check and fix Undefined errors when using MyPrelude functions

parent 5b3e43f7
Pipeline #237 failed with stage
-- | Utility functions to work with names, modules, etc.
module StaticAnalysis.StaticChecks.Select
(declName, defFuncs, defNames, expsOfDecl, getNameOfQName, importedModules
(declName, declsOfModule, defFuncs, defNames, expsOfDecl, getNameOfQName
, modName, namePos, nameOfModule, nameString, typeSigs, qNameName, qNamesOfExps
, similar3, varsOfDecl
, similar3, varsOfDecl, infixQNames, importedModules
) where
import AstChecks.Check (mapOverDecls, mapOverExp,
mapOverExpRec)
import Data.Char (ord)
import Data.List (sortBy)
import Data.Maybe (catMaybes)
import Data.Maybe (catMaybes, mapMaybe)
import Language.Haskell.Exts
import StaticAnalysis.Messages.StaticErrors (Entity (..))
import Text.EditDistance (defaultEditCosts,
......@@ -25,7 +25,8 @@ defFuncs _ = []
-- | Returns names of definitions of a module
defNames :: Module l -> [(Name l, Entity)]
defNames m@Module{} = concatMap declName $ funBinds m ++ patBinds m ++ dataDecls m
defNames m@Module{} = concatMap declName $
funBinds m ++ patBinds m ++ dataDecls m
defNames _ = []
-- | Returns name and type of a declaration
......@@ -33,10 +34,14 @@ declName :: Decl l -> [(Name l, Entity)]
declName d = case d of
TypeSig _ ns _ -> map (\n -> (n, Signature)) ns
FunBind _ (Match _ n _ _ _ :_) -> [(n, Function)]
FunBind _ (InfixMatch _ _ n _ _ _:_) -> [(n, Function)]
-- functions without arguments
PatBind _ (PVar _ n) _ _ -> [(n, Definition)]
DataDecl _ _ _ (DHead _ n) _ _ -> [(n, Datatype)]
DataDecl _ _ _ (DHApp _ (DHead _ n) _) _ _ -> [(n, Datatype)]
InfixDecl _ _ _ ops -> map opName ops
where opName (VarOp _ name) = (name, Function)
opName (ConOp _ name) = (name, Function)
_ -> []
-- | Returns name of a QName
......@@ -108,14 +113,20 @@ patBinds = declFilter isPatBind
isPatBind PatBind{} = True
isPatBind _ = False
-- Returns function bindings of a module
-- | Returns function bindings of a module
funBinds :: Module l -> [Decl l]
funBinds = declFilter isFunBind
where
isFunBind :: Decl l -> Bool
isFunBind FunBind{} = True
isFunBind _ = False
-- | Returns infix operators of a module
infixDecls :: Module l -> [Decl l]
infixDecls = declFilter isInfixDecl
where
isInfixDecl InfixDecl{} = True
isInfixDecl _ = False
-- | Returns data declarations of a module
dataDecls :: Module l -> [Decl l]
dataDecls = declFilter isFunBind
......@@ -161,6 +172,11 @@ expsOfModule :: Module l -> [Exp l]
expsOfModule (Module _ _ _ _ decls) = mapOverDecls (: []) decls
expsOfModule _ = []
-- | Returns declarations of a module
declsOfModule :: Module l -> [Decl l]
declsOfModule (Module _ _ _ _ decls) = decls
declsOfModule _ = []
-- | Returns expressions of a declaration
expsOfDecl :: Decl l -> [Exp l]
expsOfDecl d = mapOverDecls (: []) [d]
......@@ -169,6 +185,15 @@ expsOfDecl d = mapOverDecls (: []) [d]
qNamesOfExps :: [Exp l] -> [QName l]
qNamesOfExps exps = catMaybes $ concatMap (mapOverExp expQName) exps
-- | Returns qualified names of infix operators of a list of expressions
infixQNames :: [Exp l] -> [QName l]
infixQNames = mapMaybe infQn
where infQn (InfixApp _ _ qop _) = Just $ qOpQn qop
infQn _ = Nothing
qOpQn (QVarOp _ qn) = qn
qOpQn (QConOp _ qn) = qn
-- | Returns qualified names of an expression
expQName :: Exp l -> [Maybe (QName l)]
expQName (Var _ qn) = [Just qn]
......
......@@ -18,15 +18,17 @@ undef m@(Module _ _ _ _ ds) ms = if impModsAsArg then concatMap undef' ds
argMods = filter (/= "Prelude") $ map modName $ mapMaybe nameOfModule
ms
impModsAsArg = all (`elem` argMods) impMods
qns d = nub $ qNamesOfExps (expsOfDecl d)
qns d = nub $ let exps = expsOfDecl d
in qNamesOfExps exps ++ infixQNames exps
defStrs d = map nameString $ map fst (defNames m) ++ varsOfDecl d
impDefs = concatMap defStrs $ concatMap declsOfModule ms
sims qn d = similar3 d varsOfDecl (qNameName qn)
++ similar3 m (map fst . defNames) (qNameName qn)
++ concatMap (flip2 similar3 (map fst . defNames)
(qNameName qn)) ms
undef' d = do
qn <- qns d
guard $ (nameString . qNameName) qn `notElem` defStrs d
guard $ (nameString . qNameName) qn `notElem` defStrs d ++ impDefs
return $ Undefined (qNameName qn) (sims qn d)
undef _ _ = []
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment