moving #if to Gap.hs
This commit is contained in:
parent
a7a02a3f4c
commit
0b71748708
@ -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
|
||||||
|
@ -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
|
||||||
|
Loading…
Reference in New Issue
Block a user