Vladislav Zavialov pushed to branch wip/int-index/out-of-scope at Glasgow Haskell Compiler / GHC Commits: 5f6bef91 by Vladislav Zavialov at 2026-03-04T17:25:09+03:00 WIP: Refactor - - - - - 5 changed files: - compiler/GHC/Tc/Errors.hs - compiler/GHC/Tc/Gen/Head.hs - compiler/GHC/Tc/Utils/Env.hs - compiler/GHC/Tc/Utils/TcMType.hs - testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr Changes: ===================================== compiler/GHC/Tc/Errors.hs ===================================== @@ -5,7 +5,7 @@ module GHC.Tc.Errors( reportUnsolved, reportAllUnsolved, warnAllUnsolved, warnDefaulting, - mkDelayedErrorTerm, + pprDeferredTypeError, -- * GHC API helper functions solverReportMsg_ExpectedActuals, mismatchMsg_ExpectedActuals @@ -1387,19 +1387,15 @@ mkErrorTerm ct_loc ty ctxt msg supp hints supp hints -- This will be reported at runtime, so we always want "error:" in the report, never "warning:" - ; mkDelayedErrorTerm ty msg } - -mkDelayedErrorTerm - :: Type -- of the error term - -> MsgEnvelope TcRnMessage - -> TcM EvTerm -mkDelayedErrorTerm ty msg - = do { dflags <- getDynFlags - ; let err_msg = pprLocMsgEnvelope (initTcMessageOpts dflags) msg - err_str = showSDoc dflags $ - err_msg $$ text "(deferred type error)" - - ; return $ evDelayedError ty err_str } + ; dflags <- getDynFlags + ; let err_msg = pprDeferredTypeError dflags msg + ; return $ evDelayedError ty err_msg } + +pprDeferredTypeError :: DynFlags -> MsgEnvelope TcRnMessage -> String +pprDeferredTypeError dflags msg = + let err_msg = pprLocMsgEnvelope (initTcMessageOpts dflags) msg + in showSDoc dflags $ + err_msg $$ text "(deferred type error)" tryReporters :: SolverReportErrCtxt -> [ReporterSpec] -> [ErrorItem] -> TcM (SolverReportErrCtxt, [ErrorItem]) -- Use the first reporter in the list whose predicate says True ===================================== compiler/GHC/Tc/Gen/Head.hs ===================================== @@ -39,7 +39,7 @@ import GHC.Tc.Utils.Unify import GHC.Tc.Utils.Instantiate import GHC.Tc.Instance.Family ( tcLookupDataFamInst ) import GHC.Tc.Errors.Types -import GHC.Tc.Errors +import GHC.Tc.Errors ( pprDeferredTypeError ) import GHC.Tc.Solver ( InferMode(..), simplifyInfer ) import GHC.Tc.Utils.Env import GHC.Tc.Utils.TcMType @@ -832,20 +832,18 @@ tc_infer_id (L loc qnm@(WithUserRdr rdr id_name)) | otherwise = ErrorWithoutFlag msg <- mk_msg reason addDiagnosticTc msg - if defer_out_of_scope then msg_to_hole msg else failM + msg_to_hole msg msg_to_hole :: TcRnMessage -> TcM (HsExpr GhcTc, TcType) msg_to_hole msg = do - loc <- getSrcSpanM - let locc = L (noAnnSrcSpan loc) rdr - ty <- newOpenFlexiTyVarTy - u <- newUnique - msg_envelope <- mkTcRnMessage loc msg - delayed_err <- mkDelayedErrorTerm ty msg_envelope - ref <- newTcRef delayed_err + dflags <- getDynFlags + let lrdr = L loc rdr + msg_envelope <- mkTcRnMessage (locA loc) msg + let err_msg = pprDeferredTypeError dflags msg_envelope + ty <- newOpenFlexiTyVarTy + her <- newExprHoleRef ty (evDelayedError ty err_msg) tcEmitBindingUsage bottomUE -- Holes fit any usage environment (#18491) - let her = HER ref ty u - return (HsHole (HoleVar locc, her), ty) + return (HsHole (HoleVar lrdr, her), ty) {- Note [Overview of assertions] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ===================================== compiler/GHC/Tc/Utils/Env.hs ===================================== @@ -402,7 +402,6 @@ mkIllegalTyVarMessage :: DiagnosticReason -> WithUserRdr Name -> TcM TcRnMessage fail_with_msg :: DiagnosticReason -> WhatLooking -> NameSpace -> RdrName -> Name -> Maybe TermLevelUseCtxt -> TermLevelUseErr -> TcM TcRnMessage fail_with_msg reason what_looking whatName rdr nm pprov err = do - -- defer_out_of_scope <- goptM Opt_DeferOutOfScopeVariables (imp_errs, hints) <- get_suggestions what_looking whatName rdr hfdc <- getHoleFitDispConfig unit_state <- hsc_units <$> getTopEnv ===================================== compiler/GHC/Tc/Utils/TcMType.hs ===================================== @@ -45,6 +45,8 @@ module GHC.Tc.Utils.TcMType ( emitWantedEqs, emitNewExprHole, newTcEvBinds, newNoTcEvBinds, addTcEvBind, + newExprHoleRef, + newCoercionHole, fillCoercionHole, isFilledCoercionHole, checkCoercionHole, @@ -314,6 +316,12 @@ emitNewExprHole occ ty ; emitHole hole ; return her } +newExprHoleRef :: Type -> EvTerm -> TcM HoleExprRef +newExprHoleRef ty ev + = do { u <- newUnique + ; ref <- newTcRef ev + ; return $ HER ref ty u } + newDict :: Class -> [TcType] -> TcM DictId newDict cls tys = do { name <- newSysName (mkDictOcc (getOccName cls)) ===================================== testsuite/tests/rename/should_fail/RnStaticPointersFail02.stderr ===================================== @@ -1,3 +1,9 @@ +RnStaticPointersFail02.hs:5:5: error: [GHC-39999] + • No instance for ‘ghc-internal-9.1500.0:GHC.Internal.Data.Typeable.Internal.Typeable + t0’ + arising from a static form + • In the expression: static T + In an equation for ‘f’: f = static T RnStaticPointersFail02.hs:5:12: error: [GHC-01928] • Illegal term-level use of the type constructor ‘T’ @@ -5,3 +11,4 @@ RnStaticPointersFail02.hs:5:12: error: [GHC-01928] • In the body of a static form: T In the expression: static T In an equation for ‘f’: f = static T + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f6bef914e323c9e42efff914d6050a9... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/5f6bef914e323c9e42efff914d6050a9... You're receiving this email because of your account on gitlab.haskell.org.