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

Commit cfd682c

Browse files
committed
Changes from #14579
We now have a top-level `tyConAppNeedsKindSig` function, which means that we can delete lots of code in `Convert`.
1 parent 44226fc commit cfd682c

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

@@ -539,7 +537,7 @@ synifyType _ vs (TyConApp tc tys)
539537
= noLoc (HsTyVar noExt NotPromoted (noLoc liftedTypeKindTyConName))
540538
-- Use non-prefix tuple syntax where possible, because it looks nicer.
541539
| Just sort <- tyConTuple_maybe tc
542-
, tyConArity tc == length tys
540+
, tyConArity tc == tys_len
543541
= noLoc $ HsTupleTy noExt
544542
(case sort of
545543
BoxedTuple -> HsBoxedTuple
@@ -596,32 +594,17 @@ synifyType _ vs (TyConApp tc tys)
596594
(map (synifyType WithinType vs) $
597595
filterOut isCoercionTy ty_args)
598596

599-
vis_tys = filterOutInvisibleTypes tc tys
600-
binders = tyConBinders tc
601-
res_kind = tyConResKind tc
597+
tys_len = length tys
598+
vis_tys = filterOutInvisibleTypes tc tys
602599

603600
maybe_sig :: LHsType GhcRn -> LHsType GhcRn
604601
maybe_sig ty'
605-
| needs_kind_sig
602+
| tyConAppNeedsKindSig False tc tys_len
606603
= let full_kind = typeKind (mkTyConApp tc tys)
607604
full_kind' = synifyType WithinType vs full_kind
608605
in noLoc $ HsKindSig noExt ty' full_kind'
609606
| otherwise = ty'
610607

611-
needs_kind_sig :: Bool
612-
needs_kind_sig
613-
| GT <- compareLength tys binders
614-
= False
615-
| otherwise
616-
= let (dropped_binders, remaining_binders)
617-
= splitAtList tys binders
618-
result_kind = mkTyConKind remaining_binders res_kind
619-
result_vars = tyCoVarsOfType result_kind
620-
dropped_vars = fvVarSet $
621-
mapUnionFV injectiveVarsOfBinder dropped_binders
622-
623-
in not (subVarSet result_vars dropped_vars)
624-
625608
synifyType s vs (AppTy t1 (CoercionTy {})) = synifyType s vs t1
626609
synifyType _ vs (AppTy t1 t2) = let
627610
s1 = synifyType WithinType vs t1

0 commit comments

Comments
 (0)