diff options
author | Alec Theriault <alec.theriault@gmail.com> | 2018-12-17 09:25:10 -0500 |
---|---|---|
committer | GitHub <noreply@github.com> | 2018-12-17 09:25:10 -0500 |
commit | ed43757aa371f9a532665783e27cff1703b4ac90 (patch) | |
tree | d797068322124edcd022ebb1a2873a8b7157f0bf /haddock-api/src/Haddock/Interface | |
parent | 1380f7fa048ba26f79944452722dff0800b49038 (diff) |
Refactor names + unused functions (#982)
This commit should not introduce any change in functionality!
* consistently use `getOccString` to convert `Name`s to strings
* compare names directly when possible (instead of comparing strings)
* get rid of unused utility functions
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
-rw-r--r-- | haddock-api/src/Haddock/Interface/AttachInstances.hs | 14 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Interface/Specialize.hs | 13 |
2 files changed, 8 insertions, 19 deletions
diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs index 8f7abd16..dd6c70a5 100644 --- a/haddock-api/src/Haddock/Interface/AttachInstances.hs +++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE CPP, MagicHash, BangPatterns #-} +{-# LANGUAGE MagicHash, BangPatterns #-} {-# LANGUAGE TypeFamilies #-} ----------------------------------------------------------------------------- -- | @@ -32,7 +32,6 @@ import DynFlags import CoreSyn (isOrphan) import ErrUtils import FamInstEnv -import FastString import GHC import InstEnv import Module ( ModuleSet, moduleSetElts ) @@ -40,13 +39,11 @@ import MonadUtils (liftIO) import Name import NameEnv import Outputable (text, sep, (<+>)) -import PrelNames import SrcLoc import TyCon import TyCoRep -import TysPrim( funTyCon ) +import TysPrim( funTyConName ) import Var hiding (varName) -#define FSLIT(x) (mkFastString# (x#)) type ExportedNames = Set.Set Name type Modules = Set.Set Module @@ -224,13 +221,6 @@ instFam FamInst { fi_fam = n, fi_tys = ts, fi_rhs = t } = (map argCount ts, n, map simplify ts, argCount t, simplify t) -funTyConName :: Name -funTyConName = mkWiredInName gHC_PRIM - (mkOccNameFS tcName FSLIT("(->)")) - funTyConKey - (ATyCon funTyCon) -- Relevant TyCon - BuiltInSyntax - -------------------------------------------------------------------------------- -- Filtering hidden instances -------------------------------------------------------------------------------- diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index e9511e3d..5ab3a7ee 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -15,6 +15,8 @@ import Haddock.Types import GHC import Name import FastString +import TysPrim ( funTyConName ) +import TysWiredIn ( listTyConName ) import Control.Monad import Control.Monad.Trans.State @@ -110,10 +112,7 @@ sugar = sugarOperators . sugarTuples . sugarLists sugarLists :: NamedThing (IdP (GhcPass p)) => HsType (GhcPass p) -> HsType (GhcPass p) sugarLists (HsAppTy _ (L _ (HsTyVar _ _ (L _ name))) ltyp) - | isBuiltInSyntax name' && strName == "[]" = HsListTy NoExt ltyp - where - name' = getName name - strName = occNameString . nameOccName $ name' + | getName name == listTyConName = HsListTy NoExt ltyp sugarLists typ = typ @@ -127,7 +126,7 @@ sugarTuples typ = | isBuiltInSyntax name' && suitable = HsTupleTy NoExt HsBoxedTuple apps where name' = getName name - strName = occNameString . nameOccName $ name' + strName = getOccString name suitable = case parseTupleArity strName of Just arity -> arity == length apps Nothing -> False @@ -137,7 +136,7 @@ sugarTuples typ = sugarOperators :: NamedThing (IdP (GhcPass p)) => HsType (GhcPass p) -> HsType (GhcPass p) sugarOperators (HsAppTy _ (L _ (HsAppTy _ (L _ (HsTyVar _ _ (L l name))) la)) lb) | isSymOcc $ getOccName name' = mkHsOpTy la (L l name) lb - | isBuiltInSyntax name' && getOccString name == "(->)" = HsFunTy NoExt la lb + | funTyConName == name' = HsFunTy NoExt la lb where name' = getName name sugarOperators typ = typ @@ -182,7 +181,7 @@ parseTupleArity _ = Nothing type NameRep = FastString getNameRep :: NamedThing name => name -> NameRep -getNameRep = occNameFS . getOccName +getNameRep = getOccFS nameRepString :: NameRep -> String nameRepString = unpackFS |