Commit 5d651c78 authored by Krzysztof Gogolewski's avatar Krzysztof Gogolewski Committed by Marge Bot
Browse files

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.
parent 1f809093
Pipeline #39348 failed with stages
in 185 minutes and 26 seconds
......@@ -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
......
......@@ -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)
......
......@@ -26,6 +26,7 @@ module GHC.Hs.Type (
HsArrow(..), arrowToHsType,
HsLinearArrowTokens(..),
hsLinear, hsUnrestricted, isUnrestricted,
pprHsArrow,
HsType(..), HsCoreTy, LHsType, HsKind, LHsKind,
HsForAllTelescope(..), EpAnnForallTy, HsTyVarBndr(..), LHsTyVarBndr,
......
......@@ -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]
~~~~~~~~~~~~~~~~~~
......
......@@ -63,3 +63,4 @@ test('haddockExtraDocs', normal, compile, ['-haddock -Winvalid-haddock'])
test('haddockTySyn', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
test('T8944', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
test('T17652', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
test('haddockLinear', normal, compile, ['-haddock -Winvalid-haddock -ddump-parsed'])
{-# LANGUAGE LinearTypes #-}
{-# LANGUAGE GADTs #-}
module ShouldCompile where
data T where
C1 :: Int %1 -> T
C2 :: Int %m -> T
C3 :: Int -> T
==================== Parser ====================
module ShouldCompile where
data T
where
C1 :: Int %1 -> T
C2 :: Int %m -> T
C3 :: Int -> T
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment