Apoorv Ingle pushed to branch wip/spj-apporv-Oct24 at Glasgow Haskell Compiler / GHC Commits: c1dfddb4 by Apoorv Ingle at 2025-07-20T18:09:49-05:00 new CtOrigin ExpectedTySyntax - - - - - 4 changed files: - compiler/GHC/Tc/Gen/App.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Types/Origin.hs - + compiler/hie.yaml Changes: ===================================== compiler/GHC/Tc/Gen/App.hs ===================================== @@ -857,7 +857,7 @@ tcInstFun do_ql inst_final fun_orig (tc_fun, rn_fun, fun_ctxt) fun_sigma rn_args -- Rule IARG from Fig 4 of the QL paper: go1 pos acc fun_ty (EValArg { ea_arg = arg, ea_ctxt = ctxt } : rest_args) - = do { let herald = ExpectedFunTyArg pos (HsExprTcThing tc_fun) (unLoc arg) + = do { let herald = mk_herald tc_fun (unLoc arg) ; (wrap, arg_ty, res_ty) <- -- NB: matchActualFunTy does the rep-poly check. -- For example, suppose we have f :: forall r (a::TYPE r). a -> Int @@ -876,7 +876,7 @@ tcInstFun do_ql inst_final fun_orig (tc_fun, rn_fun, fun_ctxt) fun_sigma rn_args -- Make a fresh nus for each argument in rule IVAR new_arg_ty (L _ arg) i = do { arg_nu <- newOpenFlexiFRRTyVarTy $ - FRRExpectedFunTy (ExpectedFunTyArg i (HsExprTcThing tc_fun) arg) i + FRRExpectedFunTy (mk_herald tc_fun arg) i -- Following matchActualFunTy, we create nu_i :: TYPE kappa_i[conc], -- thereby ensuring that the arguments have concrete runtime representations @@ -886,6 +886,12 @@ tcInstFun do_ql inst_final fun_orig (tc_fun, rn_fun, fun_ctxt) fun_sigma rn_args ; return (mkScaled mult_ty arg_nu) } + mk_herald :: HsExpr GhcTc -> HsExpr GhcRn -> CtOrigin + mk_herald tc_fun arg + = case fun_orig of + ExpansionOrigin (OrigStmt{}) -> ExpectedTySyntax DoStmtOrigin arg + _ -> ExpectedFunTyArg (HsExprTcThing tc_fun) arg + -- Is the argument supposed to instantiate a forall? -- -- In other words, given a function application `fn arg`, ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -655,7 +655,7 @@ tcInferOverLit lit@(OverLit { ol_val = val ; let thing = NameThing from_name mb_thing = Just thing - herald = ExpectedFunTyArg 1 thing (HsLit noExtField hs_lit) + herald = ExpectedFunTyArg thing (HsLit noExtField hs_lit) ; (wrap2, sarg_ty, res_ty) <- matchActualFunTy herald mb_thing (1, from_ty) from_ty ; co <- unifyType mb_thing (hsLitType hs_lit) (scaledThing sarg_ty) ===================================== compiler/GHC/Tc/Types/Origin.hs ===================================== @@ -85,7 +85,6 @@ import GHC.Types.Unique.Supply import qualified Data.Kind as Hs import Data.List.NonEmpty (NonEmpty (..)) -import qualified Data.List.NonEmpty as NE {- ********************************************************************* * * @@ -655,6 +654,8 @@ data CtOrigin | ExpansionOrigin SrcCodeOrigin -- This is due to an expansion of the original thing given by SrcCodeOrigin + | ExpectedTySyntax !CtOrigin (HsExpr GhcRn) + -- | A rebindable syntax operator is expected to have a function type. -- -- Test cases for representation-polymorphism checks: @@ -679,8 +680,6 @@ data CtOrigin -- RepPolyApp | forall (p :: Pass) . Outputable (HsExpr (GhcPass p)) => ExpectedFunTyArg - Int - -- ^ Argument number !TypedThing -- ^ function !(HsExpr (GhcPass p)) @@ -708,7 +707,6 @@ data CtOrigin updatePositionCtOrigin :: Int -> CtOrigin -> CtOrigin updatePositionCtOrigin i (ExpectedFunTySyntaxOp _ c e) = ExpectedFunTySyntaxOp i c e updatePositionCtOrigin i (ExpectedFunTyViewPat _ e) = ExpectedFunTyViewPat i e -updatePositionCtOrigin i (ExpectedFunTyArg _ t e) = ExpectedFunTyArg i t e updatePositionCtOrigin i (ExpectedFunTyMatches _ t e) = ExpectedFunTyMatches i t e updatePositionCtOrigin _ c = c @@ -809,7 +807,7 @@ exprCtOrigin (HsMultiIf _ rhs) = lGRHSCtOrigin rhs exprCtOrigin (HsLet _ _ e) = lexprCtOrigin e exprCtOrigin (HsDo {}) = DoStmtOrigin exprCtOrigin (RecordCon {}) = Shouldn'tHappenOrigin "record construction" -exprCtOrigin (RecordUpd {}) = RecordUpdOrigin +exprCtOrigin (RecordUpd{}) = RecordUpdOrigin exprCtOrigin (ExprWithTySig {}) = ExprSigOrigin exprCtOrigin (ArithSeq {}) = Shouldn'tHappenOrigin "arithmetic sequence" exprCtOrigin (HsPragE _ _ e) = lexprCtOrigin e @@ -858,11 +856,20 @@ pprCtOrigin (GivenOrigin sk) pprCtOrigin (ExpansionOrigin o) = ctoHerald <+> what - where what :: SDoc - what = case o of - OrigStmt{} -> text "a do statement" - OrigExpr e -> pprCtO (exprCtOrigin e) - OrigPat p -> text "a pattern" <+> ppr p + where + what :: SDoc + what = case o of + OrigStmt{} -> + text "a do statement" + OrigPat p -> + text "a do statement" $$ + text "with the failable pattern" <+> quotes (ppr p) + OrigExpr (HsGetField _ _ (L _ f)) -> + hsep [text "selecting the field", quotes (ppr f)] + OrigExpr (HsOverLabel _ l) -> + hsep [text "the overloaded label" ,quotes (char '#' <> ppr l)] + OrigExpr e@(RecordUpd{}) -> hsep [text "a record update" <+> quotes (ppr e) ] + OrigExpr e -> text "the expression" <+> (ppr e) pprCtOrigin (GivenSCOrigin sk d blk) = vcat [ ctoHerald <+> pprSkolInfo sk @@ -976,16 +983,21 @@ pprCtOrigin (NonLinearPatternOrigin reason pat) = hang (ctoHerald <+> text "a non-linear pattern" <+> quotes (ppr pat)) 2 (pprNonLinearPatternReason reason) +pprCtOrigin (ExpectedTySyntax orig arg) + = vcat [ text "The expression" <+> quotes (ppr arg) + , nest 2 (ppr orig) ] + pprCtOrigin (ExpectedFunTySyntaxOp i orig op) = vcat [ sep [ the_arg_of i , text "the rebindable syntax operator" , quotes (ppr op) ] , nest 2 (ppr orig) ] + pprCtOrigin (ExpectedFunTyViewPat i expr) = vcat [ the_arg_of i <+> text "the view pattern" , nest 2 (ppr expr) ] -pprCtOrigin (ExpectedFunTyArg i fun arg) = - sep [ text "The" <+> speakNth i <+> text "argument" +pprCtOrigin (ExpectedFunTyArg fun arg) = + sep [ text "The argument" , quotes (ppr arg) , text "of" , quotes (ppr fun) ] @@ -1076,10 +1088,10 @@ pprCtO (InstanceSigOrigin {}) = text "a type signature in an instance" pprCtO (AmbiguityCheckOrigin {}) = text "a type ambiguity check" pprCtO (ImpedanceMatching {}) = text "combining required constraints" pprCtO (NonLinearPatternOrigin _ pat) = hsep [text "a non-linear pattern" <+> quotes (ppr pat)] -pprCtO (ExpansionOrigin (OrigPat p)) = hsep [text "a pattern" <+> quotes (ppr p)] -pprCtO (ExpansionOrigin (OrigStmt{})) = text "a do statement" -pprCtO (ExpansionOrigin (OrigExpr (HsGetField _ _ (L _ f)))) = hsep [text "selecting the field", quotes (ppr f)] pprCtO (ExpansionOrigin (OrigExpr e)) = text "an expression" <+> ppr e +pprCtO (ExpansionOrigin (OrigStmt{})) = text "a do statement" +pprCtO (ExpansionOrigin (OrigPat{})) = text "a pattern" +pprCtO (ExpectedTySyntax o _) = pprCtO o pprCtO (ExpectedFunTySyntaxOp{}) = text "a rebindable syntax operator" pprCtO (ExpectedFunTyViewPat{}) = text "a view pattern" pprCtO (ExpectedFunTyArg{}) = text "a funtion head" @@ -1298,7 +1310,7 @@ data FixedRuntimeRepContext -- -- See 'ExpectedFunTyOrigin' for more details. | FRRExpectedFunTy - !CtOrigin -- !ExpectedFunTyOrigin + !CtOrigin !Int -- ^ argument position (1-indexed) @@ -1540,7 +1552,7 @@ pprExpectedFunTyHerald (ExpectedFunTySyntaxOp {}) = text "This rebindable syntax expects a function with" pprExpectedFunTyHerald (ExpectedFunTyViewPat {}) = text "A view pattern expression expects" -pprExpectedFunTyHerald (ExpectedFunTyArg _ fun _) +pprExpectedFunTyHerald (ExpectedFunTyArg fun _) = sep [ text "The function" <+> quotes (ppr fun) , text "is applied to" ] pprExpectedFunTyHerald (ExpectedFunTyMatches _ fun (MG { mg_alts = L _ alts })) ===================================== compiler/hie.yaml ===================================== @@ -0,0 +1,9 @@ +# This is a IDE configuration file which tells IDEs such as `ghcide` how +# to set up a GHC API session for this project. +# +# To use it in windows systems replace the config with +# cradle: {bios: {program: "./hadrian/hie-bios.bat"}} +# +# The format is documented here - https://github.com/mpickering/hie-bios +cradle: {bios: {program: "./hadrian/hie-bios", + with-ghc: "~/.ghcup/bin/ghc" }} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1dfddb4d0ab6aec42b35b2901922030... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c1dfddb4d0ab6aec42b35b2901922030... You're receiving this email because of your account on gitlab.haskell.org.