hasufell
/
ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

type for Pat

This commit is contained in:
eagletmt 2012-02-18 19:14:29 +09:00
parent bf93fcab12
commit 69744de042
1 changed files with 13 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
Info.hs
View File

@ -23,6 +23,7 @@ import PprTyThing
import Pretty (showDocWith, Mode(OneLineMode))
import System.Time
import TcRnTypes
import TcHsSyn (hsPatType)
import Types
----------------------------------------------------------------
@ -58,7 +59,9 @@ typeOf opt fileName modstr lineNo colNo =
ets <- catMaybes <$> mapM (getExprType tcm) es
let bs = findBind tcm lineNo colNo
bts = catMaybes $ map getBindType bs
let sss = map toTup $ sortBy (cmp `on` fst) $ ets ++ bts
let ps = findPat tcm lineNo colNo
pts = map getPatType ps
let sss = map toTup $ sortBy (cmp `on` fst) $ concat [ets, bts, pts]
return $ convert opt sss
toTup :: (SrcSpan, Type) -> ((Int,Int,Int,Int),String)
@ -89,6 +92,12 @@ findBind TypecheckedModule{tm_typechecked_source = src} line col = listifyStaged
f (L _ (FunBind{fun_id = L spn _})) = isGoodSrcSpan spn && spn `spans` (line, col)
f _ = False
findPat :: TypecheckedModule -> Int -> Int -> [LPat Id]
findPat TypecheckedModule{tm_typechecked_source = src} line col = listifyStaged TypeChecker f src
where
f :: LPat Id -> Bool
f (L spn _) = isGoodSrcSpan spn && spn `spans` (line, col)
listifyStaged :: Typeable r => Stage -> (r -> Bool) -> GenericQ [r]
listifyStaged s p = everythingStaged s (++) [] ([] `mkQ` (\x -> [x | p x]))
@ -106,6 +115,9 @@ getBindType :: LHsBind Id -> Maybe (SrcSpan, Type)
getBindType (L _ FunBind{fun_id = L spn _, fun_matches = MatchGroup _ typ}) = Just (spn, typ)
getBindType _ = Nothing
getPatType :: LPat Id -> (SrcSpan, Type)
getPatType (L spn pat) = (spn, hsPatType pat)
pretty :: Type -> String
pretty = showDocWith OneLineMode . withPprStyleDoc (mkUserStyle neverQualify AllTheWay) . pprTypeForUser False