diff options
| author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2021-07-29 20:48:04 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-08-05 07:14:39 -0400 |
| commit | 5d651c78fed7e55b3b3cd21a04499d1a2f75204d (patch) | |
| tree | a60bb609ff4735e3f50ae179c906d5bba63bfc8e /compiler/GHC/Hs | |
| parent | 1f8090933268b1ca071bc4a8a35b0f1828a76fce (diff) | |
| download | haskell-5d651c78fed7e55b3b3cd21a04499d1a2f75204d.tar.gz | |
Minor fix to pretty-printing of linear types
The function ppr_arrow_chain was not printing multiplicities.
Also remove the Outputable instance: no longer used, and could cover
bugs like those.
Diffstat (limited to 'compiler/GHC/Hs')
| -rw-r--r-- | compiler/GHC/Hs/Decls.hs | 15 | ||||
| -rw-r--r-- | compiler/GHC/Hs/Type.hs | 1 |
2 files changed, 10 insertions, 6 deletions
diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs index 4b543cb8ef..997fbdceca 100644 --- a/compiler/GHC/Hs/Decls.hs +++ b/compiler/GHC/Hs/Decls.hs @@ -705,13 +705,16 @@ pprConDecl (ConDeclGADT { con_names = cons, con_bndrs = L _ outer_bndrs , con_res_ty = res_ty, con_doc = doc }) = ppr_mbDoc doc <+> ppr_con_names cons <+> dcolon <+> (sep [pprHsOuterSigTyVarBndrs outer_bndrs <+> pprLHsContext mcxt, - ppr_arrow_chain (get_args args ++ [ppr res_ty]) ]) + sep (ppr_args args ++ [ppr res_ty]) ]) where - get_args (PrefixConGADT args) = map ppr args - get_args (RecConGADT fields _) = [pprConDeclFields (unLoc fields)] - - ppr_arrow_chain (a:as) = sep (a : map (arrow <+>) as) - ppr_arrow_chain [] = empty + ppr_args (PrefixConGADT args) = map (\(HsScaled arr t) -> ppr t <+> ppr_arr arr) args + ppr_args (RecConGADT fields _) = [pprConDeclFields (unLoc fields) <+> arrow] + + -- Display linear arrows as unrestricted with -XNoLinearTypes + -- (cf. dataConDisplayType in Note [Displaying linear fields] in GHC.Core.DataCon) + ppr_arr (HsLinearArrow _) = sdocOption sdocLinearTypes $ \show_linear_types -> + if show_linear_types then lollipop else arrow + ppr_arr arr = pprHsArrow arr ppr_con_names :: (OutputableBndr a) => [GenLocated l a] -> SDoc ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc) diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs index 399c89f93d..e1f137052b 100644 --- a/compiler/GHC/Hs/Type.hs +++ b/compiler/GHC/Hs/Type.hs @@ -26,6 +26,7 @@ module GHC.Hs.Type ( HsArrow(..), arrowToHsType, HsLinearArrowTokens(..), hsLinear, hsUnrestricted, isUnrestricted, + pprHsArrow, HsType(..), HsCoreTy, LHsType, HsKind, LHsKind, HsForAllTelescope(..), EpAnnForallTy, HsTyVarBndr(..), LHsTyVarBndr, |