diff options
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs | 4 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Convert.hs | 20 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/GhcUtils.hs | 6 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/AttachInstances.hs | 6 |
4 files changed, 17 insertions, 19 deletions
diff --git a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs index 4e8b88d2..67eb10b5 100644 --- a/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs +++ b/haddock-api/src/Haddock/Backends/Hyperlinker/Utils.hs @@ -129,8 +129,8 @@ recoverFullIfaceTypes df flattened ast = fmap (printed A.!) ast go (HLitTy l) = IfaceLitTy l go (HForAllTy ((n,k),af) t) = let b = (getOccFS n, k) in IfaceForAllTy (Bndr (IfaceTvBndr b) af) t - go (HFunTy a b) = IfaceFunTy a b - go (HQualTy con b) = IfaceDFunTy con b + go (HFunTy a b) = IfaceFunTy VisArg a b + go (HQualTy con b) = IfaceFunTy InvisArg con b go (HCastTy a) = a go HCoercionTy = IfaceTyVar "<coercion type>" go (HTyConApp a xs) = IfaceTyConApp a (hieToIfaceArgs xs) diff --git a/haddock-api/src/Haddock/Convert.hs b/haddock-api/src/Haddock/Convert.hs index 37bad0d8..f3c40be1 100644 --- a/haddock-api/src/Haddock/Convert.hs +++ b/haddock-api/src/Haddock/Convert.hs @@ -610,11 +610,11 @@ synifyType _ vs (AppTy t1 t2) = let s1 = synifyType WithinType vs t1 s2 = synifyType WithinType vs t2 in noLoc $ HsAppTy noExt s1 s2 -synifyType s vs funty@(FunTy t1 t2) - | isPredTy t1 = synifyForAllType s vs funty - | otherwise = let s1 = synifyType WithinType vs t1 - s2 = synifyType WithinType vs t2 - in noLoc $ HsFunTy noExt s1 s2 +synifyType s vs funty@(FunTy InvisArg _ _) = synifyForAllType s vs funty +synifyType _ vs (FunTy VisArg t1 t2) = let + s1 = synifyType WithinType vs t1 + s2 = synifyType WithinType vs t2 + in noLoc $ HsFunTy noExt s1 s2 synifyType s vs forallty@(ForAllTy _tv _ty) = synifyForAllType s vs forallty synifyType _ _ (LitTy t) = noLoc $ HsTyLit noExt $ synifyTyLit t @@ -720,7 +720,7 @@ noKindTyVars ts ty _ -> noKindTyVars ts f in unionVarSets (func : args) noKindTyVars ts (ForAllTy _ t) = noKindTyVars ts t -noKindTyVars ts (FunTy t1 t2) = noKindTyVars ts t1 `unionVarSet` noKindTyVars ts t2 +noKindTyVars ts (FunTy _ t1 t2) = noKindTyVars ts t1 `unionVarSet` noKindTyVars ts t2 noKindTyVars ts (CastTy t _) = noKindTyVars ts t noKindTyVars _ _ = emptyVarSet @@ -739,7 +739,7 @@ synifyPatSynType ps = in implicitForAll ts [] (univ_tvs ++ ex_tvs) req_theta' (\vs -> implicitForAll ts vs [] prov_theta (synifyType WithinType)) - (mkFunTys arg_tys res_ty) + (mkVisFunTys arg_tys res_ty) synifyTyLit :: TyLit -> HsTyLit synifyTyLit (NumTyLit n) = HsNumTy NoSourceText n @@ -852,7 +852,5 @@ tcSplitPhiTyPreserveSynonyms ty0 = split ty0 [] -- | See Note [Invariant: Never expand type synonyms] tcSplitPredFunTyPreserveSynonyms_maybe :: Type -> Maybe (PredType, Type) -tcSplitPredFunTyPreserveSynonyms_maybe (FunTy arg res) - | isPredTy arg = Just (arg, res) -tcSplitPredFunTyPreserveSynonyms_maybe _ - = Nothing +tcSplitPredFunTyPreserveSynonyms_maybe (FunTy InvisArg arg res) = Just (arg, res) +tcSplitPredFunTyPreserveSynonyms_maybe _ = Nothing diff --git a/haddock-api/src/Haddock/GhcUtils.hs b/haddock-api/src/Haddock/GhcUtils.hs index 58cdd860..63303bfa 100644 --- a/haddock-api/src/Haddock/GhcUtils.hs +++ b/haddock-api/src/Haddock/GhcUtils.hs @@ -599,7 +599,7 @@ tyCoFVsOfType' (TyVarTy v) a b c = (FV.unitFV v `unionFV` tyCoFVsOfType' tyCoFVsOfType' (TyConApp _ tys) a b c = tyCoFVsOfTypes' tys a b c tyCoFVsOfType' (LitTy {}) a b c = emptyFV a b c tyCoFVsOfType' (AppTy fun arg) a b c = (tyCoFVsOfType' arg `unionFV` tyCoFVsOfType' fun) a b c -tyCoFVsOfType' (FunTy arg res) a b c = (tyCoFVsOfType' res `unionFV` tyCoFVsOfType' arg) a b c +tyCoFVsOfType' (FunTy _ arg res) a b c = (tyCoFVsOfType' res `unionFV` tyCoFVsOfType' arg) a b c tyCoFVsOfType' (ForAllTy bndr ty) a b c = tyCoFVsBndr' bndr (tyCoFVsOfType' ty) a b c tyCoFVsOfType' (CastTy ty _) a b c = (tyCoFVsOfType' ty) a b c tyCoFVsOfType' (CoercionTy _ ) a b c = emptyFV a b c @@ -645,8 +645,8 @@ defaultRuntimeRepVars = go emptyVarEnv go subs (TyConApp tc tc_args) = TyConApp tc (map (go subs) tc_args) - go subs (FunTy arg res) - = FunTy (go subs arg) (go subs res) + go subs (FunTy af arg res) + = FunTy af (go subs arg) (go subs res) go subs (AppTy t u) = AppTy (go subs t) (go subs u) diff --git a/haddock-api/src/Haddock/Interface/AttachInstances.hs b/haddock-api/src/Haddock/Interface/AttachInstances.hs index dd6c70a5..35f24ee5 100644 --- a/haddock-api/src/Haddock/Interface/AttachInstances.hs +++ b/haddock-api/src/Haddock/Interface/AttachInstances.hs @@ -194,13 +194,13 @@ instHead (_, _, cls, args) argCount :: Type -> Int argCount (AppTy t _) = argCount t + 1 argCount (TyConApp _ ts) = length ts -argCount (FunTy _ _ ) = 2 +argCount (FunTy _ _ _) = 2 argCount (ForAllTy _ t) = argCount t argCount (CastTy t _) = argCount t argCount _ = 0 simplify :: Type -> SimpleType -simplify (FunTy t1 t2) = SimpleType funTyConName [simplify t1, simplify t2] +simplify (FunTy _ t1 t2) = SimpleType funTyConName [simplify t1, simplify t2] simplify (ForAllTy _ t) = simplify t simplify (AppTy t1 t2) = SimpleType s (ts ++ maybeToList (simplify_maybe t2)) where (SimpleType s ts) = simplify t1 @@ -255,7 +255,7 @@ isTypeHidden expInfo = typeHidden case t of TyVarTy {} -> False AppTy t1 t2 -> typeHidden t1 || typeHidden t2 - FunTy t1 t2 -> typeHidden t1 || typeHidden t2 + FunTy _ t1 t2 -> typeHidden t1 || typeHidden t2 TyConApp tcon args -> nameHidden (getName tcon) || any typeHidden args ForAllTy bndr ty -> typeHidden (tyVarKind (binderVar bndr)) || typeHidden ty LitTy _ -> False |