Sjoerd Visscher pushed to branch wip/T18570 at Glasgow Haskell Compiler / GHC

Commits:

7 changed files:

Changes:

  • compiler/GHC/Tc/Errors/Ppr.hs
    ... ... @@ -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

  • compiler/GHC/Tc/TyCl/PatSyn.hs
    ... ... @@ -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

  • compiler/GHC/Tc/TyCl/Utils.hs
    ... ... @@ -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

  • testsuite/tests/overloadedrecflds/should_run/overloadedrecfldsrun04.stdout
    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

  • testsuite/tests/simplCore/should_compile/OpaqueNoCastWW.stderr
    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]

  • testsuite/tests/typecheck/should_fail/CommonFieldTypeMismatch.stderr
    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 
    +

  • utils/haddock/html-test/ref/Bug294.html
    ... ... @@ -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 
    -	    > -&gt; <a href="#" title="Bug294"
    168 
    +	    > %m -&gt; <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 
    -	    > -&gt; <a href="#" title="Bug294"
    184 
    +	    > %m -&gt; <a href="#" title="Bug294"
    177 185 
     	    >A</a
    178 186 
     	    > <a href="#" class="selflink"
    179 187 
     	    >#</a

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help