Skip to content
This repository was archived by the owner on Aug 3, 2024. It is now read-only.

Commit e6ca100

Browse files
RyanGlScottbgamari
authored andcommitted
Changes from #14579
We now have a top-level `tyConAppNeedsKindSig` function, which means that we can delete lots of code in `Convert`. (cherry picked from commit cfd682c)
1 parent 2a5fc0a commit e6ca100

File tree

1 file changed

+5
-22
lines changed

1 file changed

+5
-22
lines changed

haddock-api/src/Haddock/Convert.hs

Lines changed: 5 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,6 @@ import ConLike
2828
import Data.Either (lefts, rights)
2929
import DataCon
3030
import FamInstEnv
31-
import FV
3231
import HsSyn
3332
import Name
3433
import NameSet ( emptyNameSet )
@@ -45,8 +44,7 @@ import TysWiredIn ( eqTyConName, listTyConName, liftedTypeKindTyConName
4544
import PrelNames ( hasKey, eqTyConKey, ipClassKey, tYPETyConKey
4645
, liftedRepDataConKey )
4746
import Unique ( getUnique )
48-
import Util ( chkAppend, compareLength, dropList, filterByList, filterOut
49-
, splitAtList )
47+
import Util ( chkAppend,dropList, filterByList, filterOut, splitAtList )
5048
import Var
5149
import VarSet
5250

@@ -547,7 +545,7 @@ synifyType _ vs (TyConApp tc tys)
547545
= noLoc (HsTyVar noExt NotPromoted (noLoc liftedTypeKindTyConName))
548546
-- Use non-prefix tuple syntax where possible, because it looks nicer.
549547
| Just sort <- tyConTuple_maybe tc
550-
, tyConArity tc == length tys
548+
, tyConArity tc == tys_len
551549
= noLoc $ HsTupleTy noExt
552550
(case sort of
553551
BoxedTuple -> HsBoxedTuple
@@ -604,32 +602,17 @@ synifyType _ vs (TyConApp tc tys)
604602
(map (synifyType WithinType vs) $
605603
filterOut isCoercionTy ty_args)
606604

607-
vis_tys = filterOutInvisibleTypes tc tys
608-
binders = tyConBinders tc
609-
res_kind = tyConResKind tc
605+
tys_len = length tys
606+
vis_tys = filterOutInvisibleTypes tc tys
610607

611608
maybe_sig :: LHsType GhcRn -> LHsType GhcRn
612609
maybe_sig ty'
613-
| needs_kind_sig
610+
| tyConAppNeedsKindSig False tc tys_len
614611
= let full_kind = typeKind (mkTyConApp tc tys)
615612
full_kind' = synifyType WithinType vs full_kind
616613
in noLoc $ HsKindSig noExt ty' full_kind'
617614
| otherwise = ty'
618615

619-
needs_kind_sig :: Bool
620-
needs_kind_sig
621-
| GT <- compareLength tys binders
622-
= False
623-
| otherwise
624-
= let (dropped_binders, remaining_binders)
625-
= splitAtList tys binders
626-
result_kind = mkTyConKind remaining_binders res_kind
627-
result_vars = tyCoVarsOfType result_kind
628-
dropped_vars = fvVarSet $
629-
mapUnionFV injectiveVarsOfBinder dropped_binders
630-
631-
in not (subVarSet result_vars dropped_vars)
632-
633616
synifyType s vs (AppTy t1 (CoercionTy {})) = synifyType s vs t1
634617
synifyType _ vs (AppTy t1 t2) = let
635618
s1 = synifyType WithinType vs t1

0 commit comments

Comments
 (0)