summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorKrzysztof Gogolewski <krzysztof.gogolewski@tweag.io>2021-07-29 20:48:04 +0200
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-08-05 07:14:39 -0400
commit5d651c78fed7e55b3b3cd21a04499d1a2f75204d (patch)
treea60bb609ff4735e3f50ae179c906d5bba63bfc8e /compiler
parent1f8090933268b1ca071bc4a8a35b0f1828a76fce (diff)
downloadhaskell-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')
-rw-r--r--compiler/GHC/Core/DataCon.hs4
-rw-r--r--compiler/GHC/Hs/Decls.hs15
-rw-r--r--compiler/GHC/Hs/Type.hs1
-rw-r--r--compiler/Language/Haskell/Syntax/Type.hs4
4 files changed, 12 insertions, 12 deletions
diff --git a/compiler/GHC/Core/DataCon.hs b/compiler/GHC/Core/DataCon.hs
index 1b814b5213..c4c7f90a71 100644
--- a/compiler/GHC/Core/DataCon.hs
+++ b/compiler/GHC/Core/DataCon.hs
@@ -1357,7 +1357,7 @@ MkT :: a %1 -> T a (with -XLinearTypes)
or
MkT :: a -> T a (with -XNoLinearTypes)
-There are two different methods to retrieve a type of a datacon.
+There are three different methods to retrieve a type of a datacon.
They differ in how linear fields are handled.
1. dataConWrapperType:
@@ -1369,7 +1369,7 @@ The type of the constructor, with linear arrows replaced by unrestricted ones.
Used when we don't want to introduce linear types to user (in holes
and in types in hie used by haddock).
-3. dataConDisplayType (take a boolean indicating if -XLinearTypes is enabled):
+3. dataConDisplayType (takes a boolean indicating if -XLinearTypes is enabled):
The type we'd like to show in error messages, :info and -ddump-types.
Ideally, it should reflect the type written by the user;
the function returns a type with arrows that would be required
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,
diff --git a/compiler/Language/Haskell/Syntax/Type.hs b/compiler/Language/Haskell/Syntax/Type.hs
index 74f8f98432..6827438595 100644
--- a/compiler/Language/Haskell/Syntax/Type.hs
+++ b/compiler/Language/Haskell/Syntax/Type.hs
@@ -938,10 +938,6 @@ hsMult (HsScaled m _) = m
hsScaledThing :: HsScaled pass a -> a
hsScaledThing (HsScaled _ t) = t
-instance Outputable a => Outputable (HsScaled pass a) where
- ppr (HsScaled _cnt t) = -- ppr cnt <> ppr t
- ppr t
-
{-
Note [Unit tuples]
~~~~~~~~~~~~~~~~~~