never executed always true always false
    1 {-# LANGUAGE PatternSynonyms #-}
    2 
    3 -- | Pretty-printing types and coercions.
    4 module GHC.Core.TyCo.Ppr
    5   (
    6         -- * Precedence
    7         PprPrec(..), topPrec, sigPrec, opPrec, funPrec, appPrec, maybeParen,
    8 
    9         -- * Pretty-printing types
   10         pprType, pprParendType, pprTidiedType, pprPrecType, pprPrecTypeX,
   11         pprTypeApp, pprTCvBndr, pprTCvBndrs,
   12         pprSigmaType,
   13         pprTheta, pprParendTheta, pprForAll, pprUserForAll,
   14         pprTyVar, pprTyVars,
   15         pprThetaArrowTy, pprClassPred,
   16         pprKind, pprParendKind, pprTyLit,
   17         pprDataCons, pprWithExplicitKindsWhen,
   18         pprWithTYPE, pprSourceTyCon,
   19 
   20 
   21         -- * Pretty-printing coercions
   22         pprCo, pprParendCo,
   23 
   24         debugPprType,
   25   ) where
   26 
   27 import GHC.Prelude
   28 
   29 import {-# SOURCE #-} GHC.CoreToIface
   30    ( toIfaceTypeX, toIfaceTyLit, toIfaceForAllBndr
   31    , toIfaceTyCon, toIfaceTcArgs, toIfaceCoercionX )
   32 
   33 import {-# SOURCE #-} GHC.Core.DataCon
   34    ( dataConFullSig , dataConUserTyVarBinders, DataCon )
   35 
   36 import GHC.Core.Type ( pickyIsLiftedTypeKind, pattern One, pattern Many,
   37                        splitForAllReqTVBinders, splitForAllInvisTVBinders )
   38 
   39 import GHC.Core.TyCon
   40 import GHC.Core.TyCo.Rep
   41 import GHC.Core.TyCo.Tidy
   42 import GHC.Core.TyCo.FVs
   43 import GHC.Core.Class
   44 import GHC.Types.Var
   45 
   46 import GHC.Iface.Type
   47 
   48 import GHC.Types.Var.Set
   49 import GHC.Types.Var.Env
   50 
   51 import GHC.Utils.Outputable
   52 import GHC.Utils.Panic
   53 import GHC.Types.Basic ( PprPrec(..), topPrec, sigPrec, opPrec
   54                        , funPrec, appPrec, maybeParen )
   55 
   56 {-
   57 %************************************************************************
   58 %*                                                                      *
   59                    Pretty-printing types
   60 
   61        Defined very early because of debug printing in assertions
   62 %*                                                                      *
   63 %************************************************************************
   64 
   65 @pprType@ is the standard @Type@ printer; the overloaded @ppr@ function is
   66 defined to use this.  @pprParendType@ is the same, except it puts
   67 parens around the type, except for the atomic cases.  @pprParendType@
   68 works just by setting the initial context precedence very high.
   69 
   70 Note that any function which pretty-prints a @Type@ first converts the @Type@
   71 to an @IfaceType@. See Note [IfaceType and pretty-printing] in GHC.Iface.Type.
   72 
   73 See Note [Precedence in types] in GHC.Types.Basic.
   74 -}
   75 
   76 --------------------------------------------------------
   77 -- When pretty-printing types, we convert to IfaceType,
   78 --   and pretty-print that.
   79 -- See Note [Pretty printing via Iface syntax] in GHC.Types.TyThing.Ppr
   80 --------------------------------------------------------
   81 
   82 pprType, pprParendType, pprTidiedType :: Type -> SDoc
   83 pprType       = pprPrecType topPrec
   84 pprParendType = pprPrecType appPrec
   85 
   86 -- already pre-tidied
   87 pprTidiedType = pprIfaceType . toIfaceTypeX emptyVarSet
   88 
   89 pprPrecType :: PprPrec -> Type -> SDoc
   90 pprPrecType = pprPrecTypeX emptyTidyEnv
   91 
   92 pprPrecTypeX :: TidyEnv -> PprPrec -> Type -> SDoc
   93 pprPrecTypeX env prec ty
   94   = getPprStyle $ \sty ->
   95     getPprDebug $ \debug ->
   96     if debug                    -- Use debugPprType when in
   97     then debug_ppr_ty prec ty   -- when in debug-style
   98     else pprPrecIfaceType prec (tidyToIfaceTypeStyX env ty sty)
   99     -- NB: debug-style is used for -dppr-debug
  100     --     dump-style  is used for -ddump-tc-trace etc
  101 
  102 pprTyLit :: TyLit -> SDoc
  103 pprTyLit = pprIfaceTyLit . toIfaceTyLit
  104 
  105 pprKind, pprParendKind :: Kind -> SDoc
  106 pprKind       = pprType
  107 pprParendKind = pprParendType
  108 
  109 tidyToIfaceTypeStyX :: TidyEnv -> Type -> PprStyle -> IfaceType
  110 tidyToIfaceTypeStyX env ty sty
  111   | userStyle sty = tidyToIfaceTypeX env ty
  112   | otherwise     = toIfaceTypeX (tyCoVarsOfType ty) ty
  113      -- in latter case, don't tidy, as we'll be printing uniques.
  114 
  115 tidyToIfaceType :: Type -> IfaceType
  116 tidyToIfaceType = tidyToIfaceTypeX emptyTidyEnv
  117 
  118 tidyToIfaceTypeX :: TidyEnv -> Type -> IfaceType
  119 -- It's vital to tidy before converting to an IfaceType
  120 -- or nested binders will become indistinguishable!
  121 --
  122 -- Also for the free type variables, tell toIfaceTypeX to
  123 -- leave them as IfaceFreeTyVar.  This is super-important
  124 -- for debug printing.
  125 tidyToIfaceTypeX env ty = toIfaceTypeX (mkVarSet free_tcvs) (tidyType env' ty)
  126   where
  127     env'      = tidyFreeTyCoVars env free_tcvs
  128     free_tcvs = tyCoVarsOfTypeWellScoped ty
  129 
  130 ------------
  131 pprCo, pprParendCo :: Coercion -> SDoc
  132 pprCo       co = getPprStyle $ \ sty -> pprIfaceCoercion (tidyToIfaceCoSty co sty)
  133 pprParendCo co = getPprStyle $ \ sty -> pprParendIfaceCoercion (tidyToIfaceCoSty co sty)
  134 
  135 tidyToIfaceCoSty :: Coercion -> PprStyle -> IfaceCoercion
  136 tidyToIfaceCoSty co sty
  137   | userStyle sty = tidyToIfaceCo co
  138   | otherwise     = toIfaceCoercionX (tyCoVarsOfCo co) co
  139      -- in latter case, don't tidy, as we'll be printing uniques.
  140 
  141 tidyToIfaceCo :: Coercion -> IfaceCoercion
  142 -- It's vital to tidy before converting to an IfaceType
  143 -- or nested binders will become indistinguishable!
  144 --
  145 -- Also for the free type variables, tell toIfaceCoercionX to
  146 -- leave them as IfaceFreeCoVar.  This is super-important
  147 -- for debug printing.
  148 tidyToIfaceCo co = toIfaceCoercionX (mkVarSet free_tcvs) (tidyCo env co)
  149   where
  150     env       = tidyFreeTyCoVars emptyTidyEnv free_tcvs
  151     free_tcvs = scopedSort $ tyCoVarsOfCoList co
  152 ------------
  153 pprClassPred :: Class -> [Type] -> SDoc
  154 pprClassPred clas tys = pprTypeApp (classTyCon clas) tys
  155 
  156 ------------
  157 pprTheta :: ThetaType -> SDoc
  158 pprTheta = pprIfaceContext topPrec . map tidyToIfaceType
  159 
  160 pprParendTheta :: ThetaType -> SDoc
  161 pprParendTheta = pprIfaceContext appPrec . map tidyToIfaceType
  162 
  163 pprThetaArrowTy :: ThetaType -> SDoc
  164 pprThetaArrowTy = pprIfaceContextArr . map tidyToIfaceType
  165 
  166 ------------------
  167 pprSigmaType :: Type -> SDoc
  168 pprSigmaType = pprIfaceSigmaType ShowForAllWhen . tidyToIfaceType
  169 
  170 pprForAll :: [TyCoVarBinder] -> SDoc
  171 pprForAll tvs = pprIfaceForAll (map toIfaceForAllBndr tvs)
  172 
  173 -- | Print a user-level forall; see @Note [When to print foralls]@ in
  174 -- "GHC.Iface.Type".
  175 pprUserForAll :: [TyCoVarBinder] -> SDoc
  176 pprUserForAll = pprUserIfaceForAll . map toIfaceForAllBndr
  177 
  178 pprTCvBndrs :: [TyCoVarBinder] -> SDoc
  179 pprTCvBndrs tvs = sep (map pprTCvBndr tvs)
  180 
  181 pprTCvBndr :: TyCoVarBinder -> SDoc
  182 pprTCvBndr = pprTyVar . binderVar
  183 
  184 pprTyVars :: [TyVar] -> SDoc
  185 pprTyVars tvs = sep (map pprTyVar tvs)
  186 
  187 pprTyVar :: TyVar -> SDoc
  188 -- Print a type variable binder with its kind (but not if *)
  189 -- Here we do not go via IfaceType, because the duplication with
  190 -- pprIfaceTvBndr is minimal, and the loss of uniques etc in
  191 -- debug printing is disastrous
  192 pprTyVar tv
  193   | pickyIsLiftedTypeKind kind = ppr tv  -- See Note [Suppressing * kinds]
  194   | otherwise                  = parens (ppr tv <+> dcolon <+> ppr kind)
  195   where
  196     kind = tyVarKind tv
  197 
  198 {- Note [Suppressing * kinds]
  199 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  200 Generally we want to print
  201       forall a. a->a
  202 not   forall (a::*). a->a
  203 or    forall (a::Type). a->a
  204 That is, for brevity we suppress a kind ascription of '*' (or Type).
  205 
  206 But what if the kind is (Const Type x)?
  207    type Const p q = p
  208 
  209 Then (Const Type x) is just a long way of saying Type.  But it may be
  210 jolly confusing to suppress the 'x'.  Suppose we have (polykinds/T18451a)
  211    foo :: forall a b (c :: Const Type b). Proxy '[a, c]
  212 
  213 Then this error message
  214     • These kind and type variables: a b (c :: Const Type b)
  215       are out of dependency order. Perhaps try this ordering:
  216         (b :: k) (a :: Const (*) b) (c :: Const (*) b)
  217 would be much less helpful if we suppressed the kind ascription on 'a'.
  218 
  219 Hence the use of pickyIsLiftedTypeKind.
  220 -}
  221 
  222 -----------------
  223 debugPprType :: Type -> SDoc
  224 -- ^ debugPprType is a simple pretty printer that prints a type
  225 -- without going through IfaceType.  It does not format as prettily
  226 -- as the normal route, but it's much more direct, and that can
  227 -- be useful for debugging.  E.g. with -dppr-debug it prints the
  228 -- kind on type-variable /occurrences/ which the normal route
  229 -- fundamentally cannot do.
  230 debugPprType ty = debug_ppr_ty topPrec ty
  231 
  232 debug_ppr_ty :: PprPrec -> Type -> SDoc
  233 debug_ppr_ty _ (LitTy l)
  234   = ppr l
  235 
  236 debug_ppr_ty _ (TyVarTy tv)
  237   = ppr tv  -- With -dppr-debug we get (tv :: kind)
  238 
  239 debug_ppr_ty prec ty@(FunTy { ft_af = af, ft_mult = mult, ft_arg = arg, ft_res = res })
  240   = maybeParen prec funPrec $
  241     sep [debug_ppr_ty funPrec arg, arr <+> debug_ppr_ty prec res]
  242   where
  243     arr = case af of
  244             VisArg   -> case mult of
  245                           One -> lollipop
  246                           Many -> arrow
  247                           w -> mulArrow (ppr w)
  248             InvisArg -> case mult of
  249                           Many -> darrow
  250                           _ -> pprPanic "unexpected multiplicity" (ppr ty)
  251 
  252 debug_ppr_ty prec (TyConApp tc tys)
  253   | null tys  = ppr tc
  254   | otherwise = maybeParen prec appPrec $
  255                 hang (ppr tc) 2 (sep (map (debug_ppr_ty appPrec) tys))
  256 
  257 debug_ppr_ty _ (AppTy t1 t2)
  258   = hang (debug_ppr_ty appPrec t1)  -- Print parens so we see ((a b) c)
  259        2 (debug_ppr_ty appPrec t2)  -- so that we can distinguish
  260                                     -- TyConApp from AppTy
  261 
  262 debug_ppr_ty prec (CastTy ty co)
  263   = maybeParen prec topPrec $
  264     hang (debug_ppr_ty topPrec ty)
  265        2 (text "|>" <+> ppr co)
  266 
  267 debug_ppr_ty _ (CoercionTy co)
  268   = parens (text "CO" <+> ppr co)
  269 
  270 -- Invisible forall:  forall {k} (a :: k). t
  271 debug_ppr_ty prec t
  272   | (bndrs, body) <- splitForAllInvisTVBinders t
  273   , not (null bndrs)
  274   = maybeParen prec funPrec $
  275     sep [ text "forall" <+> fsep (map ppr_bndr bndrs) <> dot,
  276           ppr body ]
  277   where
  278     -- (ppr tv) will print the binder kind-annotated
  279     -- when in debug-style
  280     ppr_bndr (Bndr tv InferredSpec)  = braces (ppr tv)
  281     ppr_bndr (Bndr tv SpecifiedSpec) = ppr tv
  282 
  283 -- Visible forall:  forall x y -> t
  284 debug_ppr_ty prec t
  285   | (bndrs, body) <- splitForAllReqTVBinders t
  286   , not (null bndrs)
  287   = maybeParen prec funPrec $
  288     sep [ text "forall" <+> fsep (map ppr_bndr bndrs) <+> arrow,
  289           ppr body ]
  290   where
  291     -- (ppr tv) will print the binder kind-annotated
  292     -- when in debug-style
  293     ppr_bndr (Bndr tv ()) = ppr tv
  294 
  295 -- Impossible case: neither visible nor invisible forall.
  296 debug_ppr_ty _ ForAllTy{}
  297   = panic "debug_ppr_ty: neither splitForAllInvisTVBinders nor splitForAllReqTVBinders returned any binders"
  298 
  299 {-
  300 Note [Infix type variables]
  301 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
  302 With TypeOperators you can say
  303 
  304    f :: (a ~> b) -> b
  305 
  306 and the (~>) is considered a type variable.  However, the type
  307 pretty-printer in this module will just see (a ~> b) as
  308 
  309    App (App (TyVarTy "~>") (TyVarTy "a")) (TyVarTy "b")
  310 
  311 So it'll print the type in prefix form.  To avoid confusion we must
  312 remember to parenthesise the operator, thus
  313 
  314    (~>) a b -> b
  315 
  316 See #2766.
  317 -}
  318 
  319 pprDataCons :: TyCon -> SDoc
  320 pprDataCons = sepWithVBars . fmap pprDataConWithArgs . tyConDataCons
  321   where
  322     sepWithVBars [] = empty
  323     sepWithVBars docs = sep (punctuate (space <> vbar) docs)
  324 
  325 pprDataConWithArgs :: DataCon -> SDoc
  326 pprDataConWithArgs dc = sep [forAllDoc, thetaDoc, ppr dc <+> argsDoc]
  327   where
  328     (_univ_tvs, _ex_tvs, _eq_spec, theta, arg_tys, _res_ty) = dataConFullSig dc
  329     user_bndrs = tyVarSpecToBinders $ dataConUserTyVarBinders dc
  330     forAllDoc  = pprUserForAll user_bndrs
  331     thetaDoc   = pprThetaArrowTy theta
  332     argsDoc    = hsep (fmap pprParendType (map scaledThing arg_tys))
  333 
  334 
  335 pprTypeApp :: TyCon -> [Type] -> SDoc
  336 pprTypeApp tc tys
  337   = pprIfaceTypeApp topPrec (toIfaceTyCon tc)
  338                             (toIfaceTcArgs tc tys)
  339     -- TODO: toIfaceTcArgs seems rather wasteful here
  340 
  341 ------------------
  342 -- | Display all kind information (with @-fprint-explicit-kinds@) when the
  343 -- provided 'Bool' argument is 'True'.
  344 -- See @Note [Kind arguments in error messages]@ in "GHC.Tc.Errors".
  345 pprWithExplicitKindsWhen :: Bool -> SDoc -> SDoc
  346 pprWithExplicitKindsWhen b
  347   = updSDocContext $ \ctx ->
  348       if b then ctx { sdocPrintExplicitKinds = True }
  349            else ctx
  350 
  351 -- | This variant preserves any use of TYPE in a type, effectively
  352 -- locally setting -fprint-explicit-runtime-reps.
  353 pprWithTYPE :: Type -> SDoc
  354 pprWithTYPE ty = updSDocContext (\ctx -> ctx { sdocPrintExplicitRuntimeReps = True }) $
  355                  ppr ty
  356 
  357 -- | Pretty prints a 'TyCon', using the family instance in case of a
  358 -- representation tycon.  For example:
  359 --
  360 -- > data T [a] = ...
  361 --
  362 -- In that case we want to print @T [a]@, where @T@ is the family 'TyCon'
  363 pprSourceTyCon :: TyCon -> SDoc
  364 pprSourceTyCon tycon
  365   | Just (fam_tc, tys) <- tyConFamInst_maybe tycon
  366   = ppr $ fam_tc `TyConApp` tys        -- can't be FunTyCon
  367   | otherwise
  368   = ppr tycon