Improve findVar function

This commit is contained in:
Sergey Vinokurov 2015-06-01 17:53:56 +03:00
parent 73b98573f4
commit a23f1f3b75
1 changed files with 20 additions and 18 deletions

View File

@ -11,7 +11,7 @@ import Data.Char (isSymbol)
import Data.Function (on) import Data.Function (on)
import Data.List (find, nub, sortBy) import Data.List (find, nub, sortBy)
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (isJust, catMaybes) import Data.Maybe (catMaybes)
import Exception (ghandle, SomeException(..)) import Exception (ghandle, SomeException(..))
import GHC (GhcMonad, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, import GHC (GhcMonad, Id, ParsedModule(..), TypecheckedModule(..), DynFlags,
SrcSpan, Type, GenLocated(L)) SrcSpan, Type, GenLocated(L))
@ -364,23 +364,25 @@ findVar :: GhcMonad m => DynFlags -> PprStyle
-> G.TypecheckedModule -> G.TypecheckedSource -> G.TypecheckedModule -> G.TypecheckedSource
-> Int -> Int -> m (Maybe (SrcSpan, String, Type, Bool)) -> Int -> Int -> m (Maybe (SrcSpan, String, Type, Bool))
findVar dflag style tcm tcs lineNo colNo = findVar dflag style tcm tcs lineNo colNo =
let lst = sortBy (cmp `on` G.getLoc) $ case lst of
listifySpans tcs (lineNo, colNo) :: [G.LHsExpr Id] e@(L _ (G.HsVar i)):others -> do
in case lst of tyInfo <- Gap.getType tcm e
e@(L _ (G.HsVar i)):others -> case tyInfo of
do tyInfo <- Gap.getType tcm e Just (span, typ)
let name = getFnName dflag style i | name == "undefined" || head name == '_' ->
if (name == "undefined" || head name == '_') && isJust tyInfo return $ Just (span, name, typ, b)
then let Just (s,t) = tyInfo where
b = case others of -- If inside an App, we need name = getFnName dflag style i
-- parenthesis -- If inside an App, we need parenthesis
[] -> False b = case others of
L _ (G.HsApp (L _ a1) (L _ a2)):_ -> L _ (G.HsApp (L _ a1) (L _ a2)):_ ->
isSearchedVar i a1 || isSearchedVar i a2 isSearchedVar i a1 || isSearchedVar i a2
_ -> False _ -> False
in return $ Just (s, name, t, b) _ -> return Nothing
else return Nothing _ -> return Nothing
_ -> return Nothing where
lst :: [G.LHsExpr Id]
lst = sortBy (cmp `on` G.getLoc) $ listifySpans tcs (lineNo, colNo)
infinitePrefixSupply :: String -> [String] infinitePrefixSupply :: String -> [String]
infinitePrefixSupply "undefined" = repeat "undefined" infinitePrefixSupply "undefined" = repeat "undefined"