@@ -28,7 +28,6 @@ import ConLike
28
28
import Data.Either (lefts , rights )
29
29
import DataCon
30
30
import FamInstEnv
31
- import FV
32
31
import HsSyn
33
32
import Name
34
33
import NameSet ( emptyNameSet )
@@ -45,8 +44,7 @@ import TysWiredIn ( eqTyConName, listTyConName, liftedTypeKindTyConName
45
44
import PrelNames ( hasKey , eqTyConKey , ipClassKey , tYPETyConKey
46
45
, liftedRepDataConKey )
47
46
import Unique ( getUnique )
48
- import Util ( chkAppend , compareLength , dropList , filterByList , filterOut
49
- , splitAtList )
47
+ import Util ( chkAppend ,dropList , filterByList , filterOut , splitAtList )
50
48
import Var
51
49
import VarSet
52
50
@@ -539,7 +537,7 @@ synifyType _ vs (TyConApp tc tys)
539
537
= noLoc (HsTyVar noExt NotPromoted (noLoc liftedTypeKindTyConName))
540
538
-- Use non-prefix tuple syntax where possible, because it looks nicer.
541
539
| Just sort <- tyConTuple_maybe tc
542
- , tyConArity tc == length tys
540
+ , tyConArity tc == tys_len
543
541
= noLoc $ HsTupleTy noExt
544
542
(case sort of
545
543
BoxedTuple -> HsBoxedTuple
@@ -596,32 +594,17 @@ synifyType _ vs (TyConApp tc tys)
596
594
(map (synifyType WithinType vs) $
597
595
filterOut isCoercionTy ty_args)
598
596
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
602
599
603
600
maybe_sig :: LHsType GhcRn -> LHsType GhcRn
604
601
maybe_sig ty'
605
- | needs_kind_sig
602
+ | tyConAppNeedsKindSig False tc tys_len
606
603
= let full_kind = typeKind (mkTyConApp tc tys)
607
604
full_kind' = synifyType WithinType vs full_kind
608
605
in noLoc $ HsKindSig noExt ty' full_kind'
609
606
| otherwise = ty'
610
607
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
-
625
608
synifyType s vs (AppTy t1 (CoercionTy {})) = synifyType s vs t1
626
609
synifyType _ vs (AppTy t1 t2) = let
627
610
s1 = synifyType WithinType vs t1
0 commit comments