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

moving #if to Gap.hs

This commit is contained in:
Kazu Yamamoto 2014-07-15 14:44:02 +09:00
parent a7a02a3f4c
commit 0b71748708
2 changed files with 27 additions and 38 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
Language/Haskell/GhcMod/FillSig.hs
View File

@ -18,12 +18,6 @@ import Outputable (PprStyle)
import qualified Type as Ty import qualified Type as Ty
import qualified HsBinds as Ty import qualified HsBinds as Ty
import qualified Class as Ty import qualified Class as Ty
#if __GLASGOW_HASKELL__ >= 706
import OccName (occName)
#else
import OccName (OccName)
import RdrName (rdrNameOcc)
#endif
import qualified Language.Haskell.Exts.Annotated as HE import qualified Language.Haskell.Exts.Annotated as HE
---------------------------------------------------------------- ----------------------------------------------------------------
@ -79,32 +73,9 @@ getSignature modSum lineNo colNo = do
-- We found an instance declaration -- We found an instance declaration
TypecheckedModule{tm_renamed_source = Just tcs TypecheckedModule{tm_renamed_source = Just tcs
,tm_checked_module_info = minfo} <- G.typecheckModule p ,tm_checked_module_info = minfo} <- G.typecheckModule p
case listifyRenamedSpans tcs (lineNo, colNo) :: [G.LInstDecl G.Name] of case Gap.getClass $ listifyRenamedSpans tcs (lineNo, colNo) of
-- Instance declarations of sort 'instance F (G a)' Just (clsName,loc) -> obtainClassInfo minfo clsName loc
#if __GLASGOW_HASKELL__ >= 708 Nothing -> return Nothing
[L loc (G.ClsInstD (G.ClsInstDecl {G.cid_poly_ty =
(L _ (G.HsForAllTy _ _ _ (L _ (G.HsAppTy (L _ (G.HsTyVar clsName)) _))))}))] ->
#elif __GLASGOW_HASKELL__ >= 706
[L loc (G.ClsInstD
(L _ (G.HsForAllTy _ _ _ (L _ (G.HsAppTy (L _ (G.HsTyVar clsName)) _)))) _ _ _)] ->
#else
[L loc (G.InstDecl
(L _ (G.HsForAllTy _ _ _ (L _ (G.HsAppTy (L _ (G.HsTyVar clsName)) _)))) _ _ _)] ->
#endif
obtainClassInfo minfo clsName loc
-- Instance declarations of sort 'instance F G' (no variables)
#if __GLASGOW_HASKELL__ >= 708
[L loc (G.ClsInstD (G.ClsInstDecl {G.cid_poly_ty =
(L _ (G.HsAppTy (L _ (G.HsTyVar clsName)) _))}))] ->
#elif __GLASGOW_HASKELL__ >= 706
[L loc (G.ClsInstD
(L _ (G.HsAppTy (L _ (G.HsTyVar clsName)) _)) _ _ _)] ->
#else
[L loc (G.InstDecl
(L _ (G.HsAppTy (L _ (G.HsTyVar clsName)) _)) _ _ _)] ->
#endif
obtainClassInfo minfo clsName loc
_ -> return Nothing
_ -> return Nothing _ -> return Nothing
where obtainClassInfo :: GhcMonad m => G.ModuleInfo -> G.Name -> SrcSpan -> m (Maybe SigInfo) where obtainClassInfo :: GhcMonad m => G.ModuleInfo -> G.Name -> SrcSpan -> m (Maybe SigInfo)
obtainClassInfo minfo clsName loc = do obtainClassInfo minfo clsName loc = do
@ -158,7 +129,7 @@ class FnArgsInfo ty name | ty -> name, name -> ty where
getFnArgs :: ty -> [FnArg] getFnArgs :: ty -> [FnArg]
instance FnArgsInfo (G.HsType G.RdrName) (G.RdrName) where instance FnArgsInfo (G.HsType G.RdrName) (G.RdrName) where
getFnName dflag style name = showOccName dflag style $ occName name getFnName dflag style name = showOccName dflag style $ Gap.occName name
getFnArgs (G.HsForAllTy _ _ _ (L _ iTy)) = getFnArgs iTy getFnArgs (G.HsForAllTy _ _ _ (L _ iTy)) = getFnArgs iTy
getFnArgs (G.HsParTy (L _ iTy)) = getFnArgs iTy getFnArgs (G.HsParTy (L _ iTy)) = getFnArgs iTy
getFnArgs (G.HsFunTy (L _ lTy) (L _ rTy)) = (if fnarg lTy then FnArgFunction else FnArgNormal):getFnArgs rTy getFnArgs (G.HsFunTy (L _ lTy) (L _ rTy)) = (if fnarg lTy then FnArgFunction else FnArgNormal):getFnArgs rTy
@ -169,11 +140,6 @@ instance FnArgsInfo (G.HsType G.RdrName) (G.RdrName) where
_ -> False _ -> False
getFnArgs _ = [] getFnArgs _ = []
#if __GLASGOW_HASKELL__ < 706
occName :: G.RdrName -> OccName
occName = rdrNameOcc
#endif
instance FnArgsInfo (HE.Type HE.SrcSpanInfo) (HE.Name HE.SrcSpanInfo) where instance FnArgsInfo (HE.Type HE.SrcSpanInfo) (HE.Name HE.SrcSpanInfo) where
getFnName _ _ (HE.Ident _ s) = s getFnName _ _ (HE.Ident _ s) = s
getFnName _ _ (HE.Symbol _ s) = s getFnName _ _ (HE.Symbol _ s) = s

23
Language/Haskell/GhcMod/Gap.hs
View File

@ -37,6 +37,8 @@ module Language.Haskell.GhcMod.Gap (
, benchmarkTargets , benchmarkTargets
, toModuleString , toModuleString
, GLMatch , GLMatch
, getClass
, occName
) where ) where
import Control.Applicative hiding (empty) import Control.Applicative hiding (empty)
@ -81,6 +83,7 @@ import GHC hiding (ClsInst)
import GHC hiding (Instance) import GHC hiding (Instance)
import Control.Arrow hiding ((<+>)) import Control.Arrow hiding ((<+>))
import Data.Convertible import Data.Convertible
import RdrName (rdrNameOcc)
#endif #endif
#if __GLASGOW_HASKELL__ >= 704 #if __GLASGOW_HASKELL__ >= 704
@ -436,3 +439,23 @@ type GLMatch = LMatch RdrName (LHsExpr RdrName)
#else #else
type GLMatch = LMatch RdrName type GLMatch = LMatch RdrName
#endif #endif
getClass :: [LInstDecl Name] -> Maybe (Name, SrcSpan)
#if __GLASGOW_HASKELL__ >= 708
-- Instance declarations of sort 'instance F (G a)'
getClass [L loc (ClsInstD (ClsInstDecl {cid_poly_ty = (L _ (HsForAllTy _ _ _ (L _ (HsAppTy (L _ (HsTyVar className)) _))))}))] = Just (className, loc)
-- Instance declarations of sort 'instance F G' (no variables)
getClass [L loc (ClsInstD (ClsInstDecl {cid_poly_ty = (L _ (HsAppTy (L _ (HsTyVar className)) _))}))] = Just (className, loc)
#elif __GLASGOW_HASKELL__ >= 706
getClass [L loc (ClsInstD (L _ (HsForAllTy _ _ _ (L _ (HsAppTy (L _ (HsTyVar className)) _)))) _ _ _)] = Just (className, loc)
getClass[L loc (ClsInstD (L _ (HsAppTy (L _ (HsTyVar className)) _)) _ _ _)] = Just (className, loc)
#else
getClass [L loc (InstDecl (L _ (HsForAllTy _ _ _ (L _ (HsAppTy (L _ (HsTyVar className)) _)))) _ _ _)] = Just (className, loc)
getClass [L loc (InstDecl (L _ (HsAppTy (L _ (HsTyVar className)) _)) _ _ _)] = Just (className, loc)
#endif
getClass _ = Nothing
#if __GLASGOW_HASKELL__ < 706
occName :: G.RdrName -> OccName
occName = rdrNameOcc
#endif