Sjoerd Visscher pushed to branch wip/T18570 at Glasgow Haskell Compiler / GHC
Commits:
-
2431bd4d
by Sjoerd Visscher at 2025-06-26T12:00:18+02:00
-
df12b161
by Sjoerd Visscher at 2025-06-26T12:00:19+02:00
9 changed files:
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/TyCl/Utils.hs
- testsuite/tests/overloadedrecflds/should_fail/DRFHoleFits.stderr
- testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.stdout
- testsuite/tests/perf/compiler/T16875.stderr
- testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
- testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr
- utils/haddock/html-test/ref/Bug294.html
Changes:
| ... | ... | @@ -3541,12 +3541,12 @@ pprHoleFit :: HoleFitDispConfig -> HoleFit -> SDoc |
| 3541 | 3541 | pprHoleFit _ (RawHoleFit sd) = sd
|
| 3542 | 3542 | pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (TcHoleFit (HoleFit {..})) =
|
| 3543 | 3543 | hang display 2 provenance
|
| 3544 | - where tyApp = sep $ zipWithEqual pprArg vars hfWrap
|
|
| 3544 | + where tyApps = concat $ zipWithEqual pprArg vars hfWrap
|
|
| 3545 | 3545 | where pprArg b arg = case binderFlag b of
|
| 3546 | - Specified -> text "@" <> pprParendType arg
|
|
| 3546 | + Specified -> [text "@" <> pprParendType arg]
|
|
| 3547 | 3547 | -- Do not print type application for inferred
|
| 3548 | 3548 | -- variables (#16456)
|
| 3549 | - Inferred -> empty
|
|
| 3549 | + Inferred -> []
|
|
| 3550 | 3550 | Required -> pprPanic "pprHoleFit: bad Required"
|
| 3551 | 3551 | (ppr b <+> ppr arg)
|
| 3552 | 3552 | tyAppVars = sep $ punctuate comma $
|
| ... | ... | @@ -3573,9 +3573,9 @@ pprHoleFit (HFDC sWrp sWrpVars sTy sProv sMs) (TcHoleFit (HoleFit {..})) = |
| 3573 | 3573 | IdHFCand id_ -> pprPrefixOcc id_
|
| 3574 | 3574 | tyDisp = ppWhen sTy $ dcolon <+> ppr hfType
|
| 3575 | 3575 | has = not . null
|
| 3576 | - wrapDisp = ppWhen (has hfWrap && (sWrp || sWrpVars))
|
|
| 3576 | + wrapDisp = ppWhen (has tyApps && (sWrp || sWrpVars))
|
|
| 3577 | 3577 | $ text "with" <+> if sWrp || not sTy
|
| 3578 | - then occDisp <+> tyApp
|
|
| 3578 | + then occDisp <+> sep tyApps
|
|
| 3579 | 3579 | else tyAppVars
|
| 3580 | 3580 | docs = case hfDoc of
|
| 3581 | 3581 | Just d -> pprHsDocStrings d
|
| ... | ... | @@ -841,7 +841,7 @@ mkPatSynRecSelBinds :: PatSyn |
| 841 | 841 | -> FieldSelectors
|
| 842 | 842 | -> [(Id, LHsBind GhcRn)]
|
| 843 | 843 | mkPatSynRecSelBinds ps fields has_sel
|
| 844 | - = [ mkOneRecordSelector False [PatSynCon ps] (RecSelPatSyn ps) fld_lbl has_sel
|
|
| 844 | + = [ mkOneRecordSelector [PatSynCon ps] (RecSelPatSyn ps) fld_lbl has_sel
|
|
| 845 | 845 | | fld_lbl <- fields ]
|
| 846 | 846 | |
| 847 | 847 | isUnidirectional :: HsPatSynDir a -> Bool
|
| ... | ... | @@ -766,8 +766,7 @@ addTyConsToGblEnv tyclss |
| 766 | 766 | do { traceTc "tcAddTyCons" $ vcat
|
| 767 | 767 | [ text "tycons" <+> ppr tyclss
|
| 768 | 768 | , text "implicits" <+> ppr implicit_things ]
|
| 769 | - ; linearEnabled <- xoptM LangExt.LinearTypes
|
|
| 770 | - ; gbl_env <- tcRecSelBinds (mkRecSelBinds linearEnabled tyclss)
|
|
| 769 | + ; gbl_env <- tcRecSelBinds (mkRecSelBinds tyclss)
|
|
| 771 | 770 | ; th_bndrs <- tcTyThBinders implicit_things
|
| 772 | 771 | ; return (gbl_env, th_bndrs)
|
| 773 | 772 | }
|
| ... | ... | @@ -850,24 +849,24 @@ tcRecSelBinds sel_bind_prs |
| 850 | 849 | , let loc = getSrcSpan sel_id ]
|
| 851 | 850 | binds = [(NonRecursive, [bind]) | (_, bind) <- sel_bind_prs]
|
| 852 | 851 | |
| 853 | -mkRecSelBinds :: Bool -> [TyCon] -> [(Id, LHsBind GhcRn)]
|
|
| 852 | +mkRecSelBinds :: [TyCon] -> [(Id, LHsBind GhcRn)]
|
|
| 854 | 853 | -- NB We produce *un-typechecked* bindings, rather like 'deriving'
|
| 855 | 854 | -- This makes life easier, because the later type checking will add
|
| 856 | 855 | -- all necessary type abstractions and applications
|
| 857 | -mkRecSelBinds allowMultiplicity tycons
|
|
| 858 | - = [ mkRecSelBind allowMultiplicity tc fld | tc <- tycons
|
|
| 859 | - , fld <- tyConFieldLabels tc ]
|
|
| 856 | +mkRecSelBinds tycons
|
|
| 857 | + = [ mkRecSelBind tc fld | tc <- tycons
|
|
| 858 | + , fld <- tyConFieldLabels tc ]
|
|
| 860 | 859 | |
| 861 | -mkRecSelBind :: Bool -> TyCon -> FieldLabel -> (Id, LHsBind GhcRn)
|
|
| 862 | -mkRecSelBind allowMultiplicity tycon fl
|
|
| 863 | - = mkOneRecordSelector allowMultiplicity all_cons (RecSelData tycon) fl
|
|
| 860 | +mkRecSelBind :: TyCon -> FieldLabel -> (Id, LHsBind GhcRn)
|
|
| 861 | +mkRecSelBind tycon fl
|
|
| 862 | + = mkOneRecordSelector all_cons (RecSelData tycon) fl
|
|
| 864 | 863 | FieldSelectors -- See Note [NoFieldSelectors and naughty record selectors]
|
| 865 | 864 | where
|
| 866 | 865 | all_cons = map RealDataCon (tyConDataCons tycon)
|
| 867 | 866 | |
| 868 | -mkOneRecordSelector :: Bool -> [ConLike] -> RecSelParent -> FieldLabel -> FieldSelectors
|
|
| 867 | +mkOneRecordSelector :: [ConLike] -> RecSelParent -> FieldLabel -> FieldSelectors
|
|
| 869 | 868 | -> (Id, LHsBind GhcRn)
|
| 870 | -mkOneRecordSelector allowMultiplicity all_cons idDetails fl has_sel
|
|
| 869 | +mkOneRecordSelector all_cons idDetails fl has_sel
|
|
| 871 | 870 | = (sel_id, L (noAnnSrcSpan loc) sel_bind)
|
| 872 | 871 | where
|
| 873 | 872 | loc = getSrcSpan sel_name
|
| ... | ... | @@ -932,7 +931,7 @@ mkOneRecordSelector allowMultiplicity all_cons idDetails fl has_sel |
| 932 | 931 | mkVisFunTy sel_mult data_ty $
|
| 933 | 932 | field_ty
|
| 934 | 933 | non_partial = length all_cons == length cons_w_field -- See Note [Multiplicity and partial selectors]
|
| 935 | - (mult_tvb, sel_mult) = if allowMultiplicity && non_partial && all_other_fields_unrestricted
|
|
| 934 | + (mult_tvb, sel_mult) = if non_partial && all_other_fields_unrestricted
|
|
| 936 | 935 | then ([mkForAllTyBinder (Invisible InferredSpec) mult_var], mkTyVarTy mult_var)
|
| 937 | 936 | else ([], manyDataConTy)
|
| 938 | 937 | mult_var = mkTyVar (mkSysTvName (mkBuiltinUnique 1) (fsLit "m")) multiplicityTy
|
| 1 | - |
|
| 2 | 1 | DRFHoleFits.hs:7:7: error: [GHC-88464]
|
| 3 | 2 | • Found hole: _ :: T -> Int
|
| 4 | 3 | • In the expression: _ :: T -> Int
|
| ... | ... | @@ -6,8 +5,8 @@ DRFHoleFits.hs:7:7: error: [GHC-88464] |
| 6 | 5 | • Relevant bindings include
|
| 7 | 6 | bar :: T -> Int (bound at DRFHoleFits.hs:7:1)
|
| 8 | 7 | Valid hole fits include
|
| 9 | - foo :: T -> Int (defined at DRFHoleFits.hs:5:16)
|
|
| 10 | 8 | bar :: T -> Int (defined at DRFHoleFits.hs:7:1)
|
| 9 | + foo :: T -> Int (defined at DRFHoleFits.hs:5:16)
|
|
| 11 | 10 | |
| 12 | 11 | DRFHoleFits.hs:8:7: error: [GHC-88464]
|
| 13 | 12 | • Found hole: _ :: A.S -> Int
|
| ... | ... | @@ -20,3 +19,4 @@ DRFHoleFits.hs:8:7: error: [GHC-88464] |
| 20 | 19 | A.foo :: A.S -> Int
|
| 21 | 20 | (imported qualified from ‘DRFHoleFits_A’ at DRFHoleFits.hs:3:1-35
|
| 22 | 21 | (and originally defined at DRFHoleFits_A.hs:5:16-18))
|
| 22 | + |
| 1 | 1 | data Main.R = Main.MkR {Main.foo :: GHC.Internal.Types.Int}
|
| 2 | -Main.foo :: Main.R -> GHC.Internal.Types.Int
|
|
| 3 | -Main.foo :: Main.R -> GHC.Internal.Types.Int
|
|
| 4 | -Main.foo :: Main.R -> GHC.Internal.Types.Int
|
|
| 2 | +Main.foo :: forall {m_0 :: GHC.Internal.Types.Multiplicity} .
|
|
| 3 | + Main.R %m_0 -> GHC.Internal.Types.Int
|
|
| 4 | +Main.foo :: forall {m_0 :: GHC.Internal.Types.Multiplicity} .
|
|
| 5 | + Main.R %m_0 -> GHC.Internal.Types.Int
|
|
| 6 | +Main.foo :: forall {m_0 :: GHC.Internal.Types.Multiplicity} .
|
|
| 7 | + Main.R %m_0 -> GHC.Internal.Types.Int
|
|
| 5 | 8 | 42 |
| ... | ... | @@ -6,7 +6,5 @@ T16875.hs:12:5: warning: [GHC-88464] [-Wtyped-holes (in -Wdefault)] |
| 6 | 6 | • In an equation for ‘a’: a = _
|
| 7 | 7 | • Relevant bindings include a :: p (bound at T16875.hs:12:1)
|
| 8 | 8 | Valid hole fits include
|
| 9 | - a :: forall {p}. p
|
|
| 10 | - with a
|
|
| 11 | - (defined at T16875.hs:12:1)
|
|
| 9 | + a :: forall {p}. p (defined at T16875.hs:12:1)
|
|
| 12 | 10 |
| 1 | 1 | |
| 2 | 2 | ==================== Tidy Core ====================
|
| 3 | 3 | Result size of Tidy Core
|
| 4 | - = {terms: 82, types: 52, coercions: 29, joins: 0/0}
|
|
| 4 | + = {terms: 83, types: 55, coercions: 31, joins: 0/0}
|
|
| 5 | 5 | |
| 6 | --- RHS size: {terms: 3, types: 3, coercions: 0, joins: 0/0}
|
|
| 7 | -unsafeToInteger1 :: forall (n :: Nat). Signed n -> Signed n
|
|
| 6 | +-- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0}
|
|
| 7 | +unsafeToInteger1
|
|
| 8 | + :: forall (n :: Nat) (m :: GHC.Internal.Types.Multiplicity).
|
|
| 9 | + Signed n %m -> Signed n
|
|
| 8 | 10 | [GblId, Arity=1, Unf=OtherCon []]
|
| 9 | -unsafeToInteger1 = \ (@(n :: Nat)) (ds :: Signed n) -> ds
|
|
| 11 | +unsafeToInteger1
|
|
| 12 | + = \ (@(n :: Nat))
|
|
| 13 | + (@(m :: GHC.Internal.Types.Multiplicity))
|
|
| 14 | + (ds :: Signed n) ->
|
|
| 15 | + ds
|
|
| 10 | 16 | |
| 11 | --- RHS size: {terms: 1, types: 0, coercions: 8, joins: 0/0}
|
|
| 12 | -unsafeToInteger :: forall (n :: Nat). Signed n -> Integer
|
|
| 17 | +-- RHS size: {terms: 1, types: 0, coercions: 10, joins: 0/0}
|
|
| 18 | +unsafeToInteger
|
|
| 19 | + :: forall (n :: Nat) {m :: GHC.Internal.Types.Multiplicity}.
|
|
| 20 | + Signed n %m -> Integer
|
|
| 13 | 21 | [GblId[[RecSel]], Arity=1, Unf=OtherCon []]
|
| 14 | 22 | unsafeToInteger
|
| 15 | 23 | = unsafeToInteger1
|
| 16 | - `cast` (forall (n :: <Nat>_N).
|
|
| 17 | - <Signed n>_R %<Many>_N ->_R OpaqueNoCastWW.N:Signed <n>_P
|
|
| 18 | - :: (forall (n :: Nat). Signed n -> Signed n)
|
|
| 19 | - ~R# (forall (n :: Nat). Signed n -> Integer))
|
|
| 24 | + `cast` (forall (n :: <Nat>_N) (m :: <GHC.Internal.Types.Multiplicity>_N).
|
|
| 25 | + <Signed n>_R %<m>_N ->_R OpaqueNoCastWW.N:Signed <n>_P
|
|
| 26 | + :: (forall (n :: Nat) (m :: GHC.Internal.Types.Multiplicity).
|
|
| 27 | + Signed n %m -> Signed n)
|
|
| 28 | + ~R# (forall (n :: Nat) (m :: GHC.Internal.Types.Multiplicity).
|
|
| 29 | + Signed n %m -> Integer))
|
|
| 20 | 30 | |
| 21 | 31 | -- RHS size: {terms: 8, types: 7, coercions: 21, joins: 0/0}
|
| 22 | 32 | times [InlPrag=OPAQUE]
|
| 1 | -CommonFieldTypeMismatch.hs:3:1: [GHC-91827]
|
|
| 2 | - Constructors A1 and A2 give different types for field ‘fld’
|
|
| 3 | - In the data type declaration for ‘A’ |
|
| 1 | +CommonFieldTypeMismatch.hs:3:1: error: [GHC-91827]
|
|
| 2 | + • Constructors A1 and A2 give different types for field ‘fld’
|
|
| 3 | + • In the data type declaration for ‘A’
|
|
| 4 | + |
|
| 5 | +CommonFieldTypeMismatch.hs:4:8: error: [GHC-83865]
|
|
| 6 | + • Couldn't match type ‘[Char]’ with ‘Int’
|
|
| 7 | + Expected: Int
|
|
| 8 | + Actual: String
|
|
| 9 | + • In the expression: fld
|
|
| 10 | + In an equation for ‘fld’: fld A2 {fld = fld} = fld
|
|
| 11 | + |
| ... | ... | @@ -159,9 +159,13 @@ |
| 159 | 159 | ><p class="src"
|
| 160 | 160 | ><a id="v:problemField" class="def"
|
| 161 | 161 | >problemField</a
|
| 162 | - > :: TO <a href="#" title="Bug294"
|
|
| 162 | + > :: <span class="keyword"
|
|
| 163 | + >forall</span
|
|
| 164 | + > {m :: <a href="#" title="GHC.Exts"
|
|
| 165 | + >Multiplicity</a
|
|
| 166 | + >}. TO <a href="#" title="Bug294"
|
|
| 163 | 167 | >A</a
|
| 164 | - > -> <a href="#" title="Bug294"
|
|
| 168 | + > %m -> <a href="#" title="Bug294"
|
|
| 165 | 169 | >A</a
|
| 166 | 170 | > <a href="#" class="selflink"
|
| 167 | 171 | >#</a
|
| ... | ... | @@ -171,9 +175,13 @@ |
| 171 | 175 | ><p class="src"
|
| 172 | 176 | ><a id="v:problemField-39-" class="def"
|
| 173 | 177 | >problemField'</a
|
| 174 | - > :: DO <a href="#" title="Bug294"
|
|
| 178 | + > :: <span class="keyword"
|
|
| 179 | + >forall</span
|
|
| 180 | + > {m :: <a href="#" title="GHC.Exts"
|
|
| 181 | + >Multiplicity</a
|
|
| 182 | + >}. DO <a href="#" title="Bug294"
|
|
| 175 | 183 | >A</a
|
| 176 | - > -> <a href="#" title="Bug294"
|
|
| 184 | + > %m -> <a href="#" title="Bug294"
|
|
| 177 | 185 | >A</a
|
| 178 | 186 | > <a href="#" class="selflink"
|
| 179 | 187 | >#</a
|