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

moving #if to Gap.hs

Browse Source
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 HsBinds 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
----------------------------------------------------------------
@ -79,32 +73,9 @@ getSignature modSum lineNo colNo = do
-- We found an instance declaration
TypecheckedModule{tm_renamed_source = Just tcs
,tm_checked_module_info = minfo} <- G.typecheckModule p
case listifyRenamedSpans tcs (lineNo, colNo) :: [G.LInstDecl G.Name] of
-- Instance declarations of sort 'instance F (G a)'
#if __GLASGOW_HASKELL__ >= 708
[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
case Gap.getClass $ listifyRenamedSpans tcs (lineNo, colNo) of
Just (clsName,loc) -> obtainClassInfo minfo clsName loc
Nothing -> return Nothing
_ -> return Nothing
where obtainClassInfo :: GhcMonad m => G.ModuleInfo -> G.Name -> SrcSpan -> m (Maybe SigInfo)
obtainClassInfo minfo clsName loc = do
@ -158,7 +129,7 @@ class FnArgsInfo ty name | ty -> name, name -> ty where
getFnArgs :: ty -> [FnArg]
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.HsParTy (L _ iTy)) = getFnArgs iTy
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
getFnArgs _ = []
#if __GLASGOW_HASKELL__ < 706
occName :: G.RdrName -> OccName
occName = rdrNameOcc
#endif
instance FnArgsInfo (HE.Type HE.SrcSpanInfo) (HE.Name HE.SrcSpanInfo) where
getFnName _ _ (HE.Ident _ 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
, toModuleString
, GLMatch
, getClass
, occName
) where
import Control.Applicative hiding (empty)
@ -81,6 +83,7 @@ import GHC hiding (ClsInst)
import GHC hiding (Instance)
import Control.Arrow hiding ((<+>))
import Data.Convertible
import RdrName (rdrNameOcc)
#endif
#if __GLASGOW_HASKELL__ >= 704
@ -436,3 +439,23 @@ type GLMatch = LMatch RdrName (LHsExpr RdrName)
#else
type GLMatch = LMatch RdrName
#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