diff options
author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2020-08-21 17:42:55 +0200 |
---|---|---|
committer | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2020-08-23 14:12:56 +0200 |
commit | d8f61182c3bdd1b6121c83be632b4941b907de88 (patch) | |
tree | 4015eda3d508be859528a460332b1b9d5baab597 /compiler | |
parent | 8b86509270227dbc61f0700c7d9261a4c7672361 (diff) | |
download | haskell-d8f61182c3bdd1b6121c83be632b4941b907de88.tar.gz |
Move pprTyTcApp' inside pprTyTcApp
No semantic change
Diffstat (limited to 'compiler')
-rw-r--r-- | compiler/GHC/Iface/Type.hs | 83 |
1 files changed, 39 insertions, 44 deletions
diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs index 1067e6cab3..57c31920b4 100644 --- a/compiler/GHC/Iface/Type.hs +++ b/compiler/GHC/Iface/Type.hs @@ -1382,58 +1382,53 @@ pprTyTcApp ctxt_prec tc tys = sdocOption sdocPrintExplicitKinds $ \print_kinds -> sdocOption sdocPrintTypeAbbreviations $ \print_type_abbreviations -> getPprDebug $ \debug -> - pprTyTcApp' ctxt_prec tc tys (PrintExplicitKinds print_kinds) - print_type_abbreviations debug - -pprTyTcApp' :: PprPrec -> IfaceTyCon -> IfaceAppArgs - -> PrintExplicitKinds -> Bool -> Bool -> SDoc -pprTyTcApp' ctxt_prec tc tys printExplicitKinds printTypeAbbreviations debug - | ifaceTyConName tc `hasKey` ipClassKey - , IA_Arg (IfaceLitTy (IfaceStrTyLit n)) - Required (IA_Arg ty Required IA_Nil) <- tys - = maybeParen ctxt_prec funPrec - $ char '?' <> ftext n <> text "::" <> ppr_ty topPrec ty - - | IfaceTupleTyCon arity sort <- ifaceTyConSort info - , not debug - , arity == ifaceVisAppArgsLength tys - = pprTuple ctxt_prec sort (ifaceTyConIsPromoted info) tys - - | IfaceSumTyCon arity <- ifaceTyConSort info - = pprSum arity (ifaceTyConIsPromoted info) tys - - | tc `ifaceTyConHasKey` consDataConKey - , PrintExplicitKinds False <- printExplicitKinds - , IA_Arg _ argf (IA_Arg ty1 Required (IA_Arg ty2 Required IA_Nil)) <- tys - , isInvisibleArgFlag argf - = pprIfaceTyList ctxt_prec ty1 ty2 - - | tc `ifaceTyConHasKey` tYPETyConKey - , IA_Arg (IfaceTyConApp rep IA_Nil) Required IA_Nil <- tys - , rep `ifaceTyConHasKey` liftedRepDataConKey - , printTypeAbbreviations -- See Note [Printing type abbreviations] - = ppr_kind_type ctxt_prec - - | tc `ifaceTyConHasKey` funTyConKey - , IA_Arg (IfaceTyConApp rep IA_Nil) Required args <- tys - , rep `ifaceTyConHasKey` manyDataConKey - , printTypeAbbreviations -- See Note [Printing type abbreviations] - = pprIfacePrefixApp ctxt_prec (parens arrow) (map (ppr_ty appPrec) (appArgsIfaceTypes $ stripInvisArgs printExplicitKinds args)) - | otherwise - = getPprDebug $ \dbg -> - if | not dbg && tc `ifaceTyConHasKey` errorMessageTypeErrorFamKey + if | ifaceTyConName tc `hasKey` ipClassKey + , IA_Arg (IfaceLitTy (IfaceStrTyLit n)) + Required (IA_Arg ty Required IA_Nil) <- tys + -> maybeParen ctxt_prec funPrec + $ char '?' <> ftext n <> text "::" <> ppr_ty topPrec ty + + | IfaceTupleTyCon arity sort <- ifaceTyConSort info + , not debug + , arity == ifaceVisAppArgsLength tys + -> pprTuple ctxt_prec sort (ifaceTyConIsPromoted info) tys + + | IfaceSumTyCon arity <- ifaceTyConSort info + -> pprSum arity (ifaceTyConIsPromoted info) tys + + | tc `ifaceTyConHasKey` consDataConKey + , False <- print_kinds + , IA_Arg _ argf (IA_Arg ty1 Required (IA_Arg ty2 Required IA_Nil)) <- tys + , isInvisibleArgFlag argf + -> pprIfaceTyList ctxt_prec ty1 ty2 + + | tc `ifaceTyConHasKey` tYPETyConKey + , IA_Arg (IfaceTyConApp rep IA_Nil) Required IA_Nil <- tys + , rep `ifaceTyConHasKey` liftedRepDataConKey + , print_type_abbreviations -- See Note [Printing type abbreviations] + -> ppr_kind_type ctxt_prec + + | tc `ifaceTyConHasKey` funTyConKey + , IA_Arg (IfaceTyConApp rep IA_Nil) Required args <- tys + , rep `ifaceTyConHasKey` manyDataConKey + , print_type_abbreviations -- See Note [Printing type abbreviations] + -> pprIfacePrefixApp ctxt_prec (parens arrow) (map (ppr_ty appPrec) $ + appArgsIfaceTypes $ stripInvisArgs (PrintExplicitKinds print_kinds) args) + + | tc `ifaceTyConHasKey` errorMessageTypeErrorFamKey + , not debug -- Suppress detail unless you _really_ want to see - -> text "(TypeError ...)" + -> text "(TypeError ...)" | Just doc <- ppr_equality ctxt_prec tc (appArgsIfaceTypes tys) - -> doc + -> doc | otherwise - -> ppr_iface_tc_app ppr_app_arg ctxt_prec tc tys_wo_kinds + -> ppr_iface_tc_app ppr_app_arg ctxt_prec tc $ + appArgsIfaceTypesArgFlags $ stripInvisArgs (PrintExplicitKinds print_kinds) tys where info = ifaceTyConInfo tc - tys_wo_kinds = appArgsIfaceTypesArgFlags $ stripInvisArgs printExplicitKinds tys ppr_kind_type :: PprPrec -> SDoc ppr_kind_type ctxt_prec = sdocOption sdocStarIsType $ \case |