[Git][ghc/ghc][wip/T18275] Expunge GhcTcId
Ben Gamari
gitlab at gitlab.haskell.org
Tue Jun 23 13:38:50 UTC 2020
Ben Gamari pushed to branch wip/T18275 at Glasgow Haskell Compiler / GHC
Commits:
59350f18 by Simon Peyton Jones at 2020-06-23T09:38:33-04:00
Expunge GhcTcId
GHC.Hs.Extension had
type GhcPs = GhcPass 'Parsed
type GhcRn = GhcPass 'Renamed
type GhcTc = GhcPass 'Typechecked
type GhcTcId = GhcTc
The last of these, GhcTcId, is a vestige of the past.
This patch expunges it from GHC.
- - - - -
20 changed files:
- compiler/GHC/Driver/Hooks.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Extension.hs
- compiler/GHC/HsToCore/ListComp.hs
- compiler/GHC/Tc/Gen/Arrow.hs
- compiler/GHC/Tc/Gen/Bind.hs
- compiler/GHC/Tc/Gen/Expr.hs-boot
- compiler/GHC/Tc/Gen/Foreign.hs
- compiler/GHC/Tc/Gen/Match.hs
- compiler/GHC/Tc/Gen/Match.hs-boot
- compiler/GHC/Tc/Gen/Pat.hs
- compiler/GHC/Tc/Gen/Rule.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/Tc/Gen/Splice.hs-boot
- compiler/GHC/Tc/TyCl/Class.hs
- compiler/GHC/Tc/TyCl/Instance.hs
- compiler/GHC/Tc/TyCl/PatSyn.hs
- compiler/GHC/Tc/Utils/Instantiate.hs
- compiler/GHC/Tc/Utils/Unify.hs
- compiler/GHC/Tc/Utils/Zonk.hs
Changes:
=====================================
compiler/GHC/Driver/Hooks.hs
=====================================
@@ -95,7 +95,7 @@ data Hooks = Hooks
, tcForeignImportsHook :: Maybe ([LForeignDecl GhcRn]
-> TcM ([Id], [LForeignDecl GhcTc], Bag GlobalRdrElt))
, tcForeignExportsHook :: Maybe ([LForeignDecl GhcRn]
- -> TcM (LHsBinds GhcTcId, [LForeignDecl GhcTcId], Bag GlobalRdrElt))
+ -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt))
, hscFrontendHook :: Maybe (ModSummary -> Hsc FrontendResult)
, hscCompileCoreExprHook ::
Maybe (HscEnv -> SrcSpan -> CoreExpr -> IO ForeignHValue)
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -2479,7 +2479,7 @@ data DelayedSplice =
TcLclEnv -- The local environment to run the splice in
(LHsExpr GhcRn) -- The original renamed expression
TcType -- The result type of running the splice, unzonked
- (LHsExpr GhcTcId) -- The typechecked expression to run and splice in the result
+ (LHsExpr GhcTc) -- The typechecked expression to run and splice in the result
-- A Data instance which ignores the argument of 'DelayedSplice'.
instance Data DelayedSplice where
=====================================
compiler/GHC/Hs/Extension.hs
=====================================
@@ -222,10 +222,9 @@ data Pass = Parsed | Renamed | Typechecked
deriving (Data)
-- Type synonyms as a shorthand for tagging
-type GhcPs = GhcPass 'Parsed -- Old 'RdrName' type param
-type GhcRn = GhcPass 'Renamed -- Old 'Name' type param
-type GhcTc = GhcPass 'Typechecked -- Old 'Id' type para,
-type GhcTcId = GhcTc -- Old 'TcId' type param
+type GhcPs = GhcPass 'Parsed -- Output of parser
+type GhcRn = GhcPass 'Renamed -- Output of renamer
+type GhcTc = GhcPass 'Typechecked -- Output of typechecker
-- | Allows us to check what phase we're in at GHC's runtime.
-- For example, this class allows us to write
=====================================
compiler/GHC/HsToCore/ListComp.hs
=====================================
@@ -647,7 +647,7 @@ dsInnerMonadComp stmts bndrs ret_op
-- , fmap (selN2 :: (t1, t2) -> t2) ys )
mkMcUnzipM :: TransForm
- -> HsExpr GhcTcId -- fmap
+ -> HsExpr GhcTc -- fmap
-> Id -- Of type n (a,b,c)
-> [Type] -- [a,b,c] (not levity-polymorphic)
-> DsM CoreExpr -- Of type (n a, n b, n c)
=====================================
compiler/GHC/Tc/Gen/Arrow.hs
=====================================
@@ -85,7 +85,7 @@ Note that
tcProc :: LPat GhcRn -> LHsCmdTop GhcRn -- proc pat -> expr
-> ExpRhoType -- Expected type of whole proc expression
- -> TcM (LPat GhcTc, LHsCmdTop GhcTcId, TcCoercion)
+ -> TcM (LPat GhcTc, LHsCmdTop GhcTc, TcCoercion)
tcProc pat cmd exp_ty
= newArrowScope $
@@ -123,7 +123,7 @@ mkCmdArrTy env t1 t2 = mkAppTys (cmd_arr env) [t1, t2]
tcCmdTop :: CmdEnv
-> LHsCmdTop GhcRn
-> CmdType
- -> TcM (LHsCmdTop GhcTcId)
+ -> TcM (LHsCmdTop GhcTc)
tcCmdTop env (L loc (HsCmdTop names cmd)) cmd_ty@(cmd_stk, res_ty)
= setSrcSpan loc $
@@ -132,14 +132,14 @@ tcCmdTop env (L loc (HsCmdTop names cmd)) cmd_ty@(cmd_stk, res_ty)
; return (L loc $ HsCmdTop (CmdTopTc cmd_stk res_ty names') cmd') }
----------------------------------------
-tcCmd :: CmdEnv -> LHsCmd GhcRn -> CmdType -> TcM (LHsCmd GhcTcId)
+tcCmd :: CmdEnv -> LHsCmd GhcRn -> CmdType -> TcM (LHsCmd GhcTc)
-- The main recursive function
tcCmd env (L loc cmd) res_ty
= setSrcSpan loc $ do
{ cmd' <- tc_cmd env cmd res_ty
; return (L loc cmd') }
-tc_cmd :: CmdEnv -> HsCmd GhcRn -> CmdType -> TcM (HsCmd GhcTcId)
+tc_cmd :: CmdEnv -> HsCmd GhcRn -> CmdType -> TcM (HsCmd GhcTc)
tc_cmd env (HsCmdPar x cmd) res_ty
= do { cmd' <- tcCmd env cmd res_ty
; return (HsCmdPar x cmd') }
@@ -316,7 +316,7 @@ tc_cmd env cmd@(HsCmdArrForm x expr f fixity cmd_args) (cmd_stk, res_ty)
; return (HsCmdArrForm x expr' f fixity cmd_args') }
where
- tc_cmd_arg :: LHsCmdTop GhcRn -> TcM (LHsCmdTop GhcTcId, TcType)
+ tc_cmd_arg :: LHsCmdTop GhcRn -> TcM (LHsCmdTop GhcTc, TcType)
tc_cmd_arg cmd
= do { arr_ty <- newFlexiTyVarTy arrowTyConKind
; stk_ty <- newFlexiTyVarTy liftedTypeKind
@@ -339,7 +339,7 @@ tcCmdMatches :: CmdEnv
-> TcType -- ^ type of the scrutinee
-> MatchGroup GhcRn (LHsCmd GhcRn) -- ^ case alternatives
-> CmdType
- -> TcM (MatchGroup GhcTcId (LHsCmd GhcTcId))
+ -> TcM (MatchGroup GhcTc (LHsCmd GhcTc))
tcCmdMatches env scrut_ty matches (stk, res_ty)
= tcMatchesCase match_ctxt (unrestricted scrut_ty) matches (mkCheckExpType res_ty)
where
@@ -423,7 +423,7 @@ tcArrDoStmt env ctxt (RecStmt { recS_stmts = stmts, recS_later_ids = later_names
tcArrDoStmt _ _ stmt _ _
= pprPanic "tcArrDoStmt: unexpected Stmt" (ppr stmt)
-tc_arr_rhs :: CmdEnv -> LHsCmd GhcRn -> TcM (LHsCmd GhcTcId, TcType)
+tc_arr_rhs :: CmdEnv -> LHsCmd GhcRn -> TcM (LHsCmd GhcTc, TcType)
tc_arr_rhs env rhs = do { ty <- newFlexiTyVarTy liftedTypeKind
; rhs' <- tcCmd env rhs (unitTy, ty)
; return (rhs', ty) }
=====================================
compiler/GHC/Tc/Gen/Bind.hs
=====================================
@@ -323,7 +323,7 @@ badBootDeclErr = text "Illegal declarations in an hs-boot file"
------------------------
tcLocalBinds :: HsLocalBinds GhcRn -> TcM thing
- -> TcM (HsLocalBinds GhcTcId, thing)
+ -> TcM (HsLocalBinds GhcTc, thing)
tcLocalBinds (EmptyLocalBinds x) thing_inside
= do { thing <- thing_inside
@@ -384,7 +384,7 @@ untouchable-range idea.
tcValBinds :: TopLevelFlag
-> [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn]
-> TcM thing
- -> TcM ([(RecFlag, LHsBinds GhcTcId)], thing)
+ -> TcM ([(RecFlag, LHsBinds GhcTc)], thing)
tcValBinds top_lvl binds sigs thing_inside
= do { -- Typecheck the signatures
@@ -420,7 +420,7 @@ tcValBinds top_lvl binds sigs thing_inside
------------------------
tcBindGroups :: TopLevelFlag -> TcSigFun -> TcPragEnv
-> [(RecFlag, LHsBinds GhcRn)] -> TcM thing
- -> TcM ([(RecFlag, LHsBinds GhcTcId)], thing)
+ -> TcM ([(RecFlag, LHsBinds GhcTc)], thing)
-- Typecheck a whole lot of value bindings,
-- one strongly-connected component at a time
-- Here a "strongly connected component" has the straightforward
@@ -461,7 +461,7 @@ tcBindGroups top_lvl sig_fn prag_fn (group : groups) thing_inside
tc_group :: forall thing.
TopLevelFlag -> TcSigFun -> TcPragEnv
-> (RecFlag, LHsBinds GhcRn) -> IsGroupClosed -> TcM thing
- -> TcM ([(RecFlag, LHsBinds GhcTcId)], thing)
+ -> TcM ([(RecFlag, LHsBinds GhcTc)], thing)
-- Typecheck one strongly-connected component of the original program.
-- We get a list of groups back, because there may
@@ -499,7 +499,7 @@ tc_group top_lvl sig_fn prag_fn (Recursive, binds) closed thing_inside
sccs :: [SCC (LHsBind GhcRn)]
sccs = stronglyConnCompFromEdgedVerticesUniq (mkEdges sig_fn binds)
- go :: [SCC (LHsBind GhcRn)] -> TcM (LHsBinds GhcTcId, thing)
+ go :: [SCC (LHsBind GhcRn)] -> TcM (LHsBinds GhcTc, thing)
go (scc:sccs) = do { (binds1, ids1) <- tc_scc scc
-- recursive bindings must be unrestricted
-- (the ids added to the environment here are the name of the recursive definitions).
@@ -532,7 +532,7 @@ recursivePatSynErr loc binds
tc_single :: forall thing.
TopLevelFlag -> TcSigFun -> TcPragEnv
-> LHsBind GhcRn -> IsGroupClosed -> TcM thing
- -> TcM (LHsBinds GhcTcId, thing)
+ -> TcM (LHsBinds GhcTc, thing)
tc_single _top_lvl sig_fn _prag_fn
(L _ (PatSynBind _ psb at PSB{ psb_id = L _ name }))
_ thing_inside
@@ -585,7 +585,7 @@ tcPolyBinds :: TcSigFun -> TcPragEnv
-- dependencies based on type signatures
-> IsGroupClosed -- Whether the group is closed
-> [LHsBind GhcRn] -- None are PatSynBind
- -> TcM (LHsBinds GhcTcId, [TcId])
+ -> TcM (LHsBinds GhcTc, [TcId])
-- Typechecks a single bunch of values bindings all together,
-- and generalises them. The bunch may be only part of a recursive
@@ -629,7 +629,7 @@ tcPolyBinds sig_fn prag_fn rec_group rec_tc closed bind_list
-- If typechecking the binds fails, then return with each
-- signature-less binder given type (forall a.a), to minimise
-- subsequent error messages
-recoveryCode :: [Name] -> TcSigFun -> TcM (LHsBinds GhcTcId, [Id])
+recoveryCode :: [Name] -> TcSigFun -> TcM (LHsBinds GhcTc, [Id])
recoveryCode binder_names sig_fn
= do { traceTc "tcBindsWithSigs: error recovery" (ppr binder_names)
; let poly_ids = map mk_dummy binder_names
@@ -662,7 +662,7 @@ tcPolyNoGen -- No generalisation whatsoever
-- dependencies based on type signatures
-> TcPragEnv -> TcSigFun
-> [LHsBind GhcRn]
- -> TcM (LHsBinds GhcTcId, [TcId])
+ -> TcM (LHsBinds GhcTc, [TcId])
tcPolyNoGen rec_tc prag_fn tc_sig_fn bind_list
= do { (binds', mono_infos) <- tcMonoBinds rec_tc tc_sig_fn
@@ -689,7 +689,7 @@ tcPolyNoGen rec_tc prag_fn tc_sig_fn bind_list
tcPolyCheck :: TcPragEnv
-> TcIdSigInfo -- Must be a complete signature
-> LHsBind GhcRn -- Must be a FunBind
- -> TcM (LHsBinds GhcTcId, [TcId])
+ -> TcM (LHsBinds GhcTc, [TcId])
-- There is just one binding,
-- it is a FunBind
-- it has a complete type signature,
@@ -803,7 +803,7 @@ tcPolyInfer
-> TcPragEnv -> TcSigFun
-> Bool -- True <=> apply the monomorphism restriction
-> [LHsBind GhcRn]
- -> TcM (LHsBinds GhcTcId, [TcId])
+ -> TcM (LHsBinds GhcTc, [TcId])
tcPolyInfer rec_tc prag_fn tc_sig_fn mono bind_list
= do { (tclvl, wanted, (binds', mono_infos))
<- pushLevelAndCaptureConstraints $
@@ -1272,7 +1272,7 @@ tcMonoBinds :: RecFlag -- Whether the binding is recursive for typechecking pur
-- we are not rescued by a type signature
-> TcSigFun -> LetBndrSpec
-> [LHsBind GhcRn]
- -> TcM (LHsBinds GhcTcId, [MonoBindInfo])
+ -> TcM (LHsBinds GhcTc, [MonoBindInfo])
tcMonoBinds is_rec sig_fn no_gen
[ L b_loc (FunBind { fun_id = L nm_loc name
, fun_matches = matches })]
@@ -1345,7 +1345,7 @@ tcMonoBinds _ sig_fn no_gen binds
data TcMonoBind -- Half completed; LHS done, RHS not done
= TcFunBind MonoBindInfo SrcSpan (MatchGroup GhcRn (LHsExpr GhcRn))
- | TcPatBind [MonoBindInfo] (LPat GhcTcId) (GRHSs GhcRn (LHsExpr GhcRn))
+ | TcPatBind [MonoBindInfo] (LPat GhcTc) (GRHSs GhcRn (LHsExpr GhcRn))
TcSigmaType
tcLhs :: TcSigFun -> LetBndrSpec -> HsBind GhcRn -> TcM TcMonoBind
@@ -1445,7 +1445,7 @@ newSigLetBndr no_gen name (TISI { sig_inst_tau = tau })
-- declarations. Which are all unrestricted currently.
-------------------
-tcRhs :: TcMonoBind -> TcM (HsBind GhcTcId)
+tcRhs :: TcMonoBind -> TcM (HsBind GhcTc)
tcRhs (TcFunBind info@(MBI { mbi_sig = mb_sig, mbi_mono_id = mono_id })
loc matches)
= tcExtendIdBinderStackForRhs [info] $
=====================================
compiler/GHC/Tc/Gen/Expr.hs-boot
=====================================
@@ -5,28 +5,28 @@ import GHC.Tc.Utils.TcType ( TcRhoType, TcSigmaType, SyntaxOpType, ExpType, ExpR
import GHC.Tc.Types ( TcM )
import GHC.Tc.Types.Origin ( CtOrigin )
import GHC.Core.Type ( Mult )
-import GHC.Hs.Extension ( GhcRn, GhcTcId )
+import GHC.Hs.Extension ( GhcRn, GhcTc )
tcCheckPolyExpr ::
LHsExpr GhcRn
-> TcSigmaType
- -> TcM (LHsExpr GhcTcId)
+ -> TcM (LHsExpr GhcTc)
tcMonoExpr, tcMonoExprNC ::
LHsExpr GhcRn
-> ExpRhoType
- -> TcM (LHsExpr GhcTcId)
+ -> TcM (LHsExpr GhcTc)
tcCheckMonoExpr, tcCheckMonoExprNC ::
LHsExpr GhcRn
-> TcRhoType
- -> TcM (LHsExpr GhcTcId)
+ -> TcM (LHsExpr GhcTc)
-tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId)
+tcExpr :: HsExpr GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
-tcInferSigma :: LHsExpr GhcRn -> TcM (LHsExpr GhcTcId, TcSigmaType)
+tcInferSigma :: LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcSigmaType)
tcInferRho, tcInferRhoNC ::
- LHsExpr GhcRn -> TcM (LHsExpr GhcTcId, TcRhoType)
+ LHsExpr GhcRn -> TcM (LHsExpr GhcTc, TcRhoType)
tcSyntaxOp :: CtOrigin
-> SyntaxExprRn
@@ -43,4 +43,4 @@ tcSyntaxOpGen :: CtOrigin
-> TcM (a, SyntaxExprTc)
-tcCheckId :: Name -> ExpRhoType -> TcM (HsExpr GhcTcId)
+tcCheckId :: Name -> ExpRhoType -> TcM (HsExpr GhcTc)
=====================================
compiler/GHC/Tc/Gen/Foreign.hs
=====================================
@@ -348,12 +348,12 @@ checkMissingAmpersand dflags arg_tys res_ty
-}
tcForeignExports :: [LForeignDecl GhcRn]
- -> TcM (LHsBinds GhcTcId, [LForeignDecl GhcTcId], Bag GlobalRdrElt)
+ -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt)
tcForeignExports decls =
getHooked tcForeignExportsHook tcForeignExports' >>= ($ decls)
tcForeignExports' :: [LForeignDecl GhcRn]
- -> TcM (LHsBinds GhcTcId, [LForeignDecl GhcTcId], Bag GlobalRdrElt)
+ -> TcM (LHsBinds GhcTc, [LForeignDecl GhcTc], Bag GlobalRdrElt)
-- For the (Bag GlobalRdrElt) result,
-- see Note [Newtype constructor usage in foreign declarations]
tcForeignExports' decls
=====================================
compiler/GHC/Tc/Gen/Match.hs
=====================================
@@ -87,7 +87,7 @@ same number of arguments before using @tcMatches@ to do the work.
tcMatchesFun :: Located Name
-> MatchGroup GhcRn (LHsExpr GhcRn)
-> ExpRhoType -- Expected type of function
- -> TcM (HsWrapper, MatchGroup GhcTcId (LHsExpr GhcTcId))
+ -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
-- Returns type of body
tcMatchesFun fn@(L _ fun_name) matches exp_ty
= do { -- Check that they all have the same no of arguments
@@ -131,13 +131,13 @@ parser guarantees that each equation has exactly one argument.
-}
tcMatchesCase :: (Outputable (body GhcRn)) =>
- TcMatchCtxt body -- Case context
- -> Scaled TcSigmaType -- Type of scrutinee
- -> MatchGroup GhcRn (Located (body GhcRn)) -- The case alternatives
- -> ExpRhoType -- Type of whole case expressions
- -> TcM (MatchGroup GhcTcId (Located (body GhcTcId)))
- -- Translated alternatives
- -- wrapper goes from MatchGroup's ty to expected ty
+ TcMatchCtxt body -- Case context
+ -> Scaled TcSigmaType -- Type of scrutinee
+ -> MatchGroup GhcRn (Located (body GhcRn)) -- The case alternatives
+ -> ExpRhoType -- Type of whole case expressions
+ -> TcM (MatchGroup GhcTc (Located (body GhcTc)))
+ -- Translated alternatives
+ -- wrapper goes from MatchGroup's ty to expected ty
tcMatchesCase ctxt (Scaled scrut_mult scrut_ty) matches res_ty
= tcMatches ctxt [Scaled scrut_mult (mkCheckExpType scrut_ty)] res_ty matches
@@ -146,7 +146,7 @@ tcMatchLambda :: SDoc -- see Note [Herald for matchExpectedFunTys] in GHC.Tc.Uti
-> TcMatchCtxt HsExpr
-> MatchGroup GhcRn (LHsExpr GhcRn)
-> ExpRhoType
- -> TcM (HsWrapper, MatchGroup GhcTcId (LHsExpr GhcTcId))
+ -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
tcMatchLambda herald match_ctxt match res_ty
= matchExpectedFunTys herald GenSigCtxt n_pats res_ty $ \ pat_tys rhs_ty ->
tcMatches match_ctxt pat_tys rhs_ty match
@@ -157,7 +157,7 @@ tcMatchLambda herald match_ctxt match res_ty
-- @tcGRHSsPat@ typechecks @[GRHSs]@ that occur in a @PatMonoBind at .
tcGRHSsPat :: GRHSs GhcRn (LHsExpr GhcRn) -> TcRhoType
- -> TcM (GRHSs GhcTcId (LHsExpr GhcTcId))
+ -> TcM (GRHSs GhcTc (LHsExpr GhcTc))
-- Used for pattern bindings
tcGRHSsPat grhss res_ty = tcGRHSs match_ctxt grhss (mkCheckExpType res_ty)
where
@@ -218,14 +218,14 @@ tcMatches :: (Outputable (body GhcRn)) => TcMatchCtxt body
-> [Scaled ExpSigmaType] -- Expected pattern types
-> ExpRhoType -- Expected result-type of the Match.
-> MatchGroup GhcRn (Located (body GhcRn))
- -> TcM (MatchGroup GhcTcId (Located (body GhcTcId)))
+ -> TcM (MatchGroup GhcTc (Located (body GhcTc)))
data TcMatchCtxt body -- c.f. TcStmtCtxt, also in this module
= MC { mc_what :: HsMatchContext GhcRn, -- What kind of thing this is
mc_body :: Located (body GhcRn) -- Type checker for a body of
-- an alternative
-> ExpRhoType
- -> TcM (Located (body GhcTcId)) }
+ -> TcM (Located (body GhcTc)) }
tcMatches ctxt pat_tys rhs_ty (MG { mg_alts = L l matches
, mg_origin = origin })
= do { (Scaled _ rhs_ty):pat_tys <- tauifyMultipleMatches matches ((Scaled One rhs_ty):pat_tys) -- return type has implicitly multiplicity 1, it doesn't matter all that much in this case since it isn't used and is eliminated immediately.
@@ -245,7 +245,7 @@ tcMatch :: (Outputable (body GhcRn)) => TcMatchCtxt body
-> [Scaled ExpSigmaType] -- Expected pattern types
-> ExpRhoType -- Expected result-type of the Match.
-> LMatch GhcRn (Located (body GhcRn))
- -> TcM (LMatch GhcTcId (Located (body GhcTcId)))
+ -> TcM (LMatch GhcTc (Located (body GhcTc)))
tcMatch ctxt pat_tys rhs_ty match
= wrapLocM (tc_match ctxt pat_tys rhs_ty) match
@@ -268,7 +268,7 @@ tcMatch ctxt pat_tys rhs_ty match
-------------
tcGRHSs :: TcMatchCtxt body -> GRHSs GhcRn (Located (body GhcRn)) -> ExpRhoType
- -> TcM (GRHSs GhcTcId (Located (body GhcTcId)))
+ -> TcM (GRHSs GhcTc (Located (body GhcTc)))
-- Notice that we pass in the full res_ty, so that we get
-- good inference from simple things like
@@ -286,7 +286,7 @@ tcGRHSs ctxt (GRHSs _ grhss (L l binds)) res_ty
-------------
tcGRHS :: TcMatchCtxt body -> ExpRhoType -> GRHS GhcRn (Located (body GhcRn))
- -> TcM (GRHS GhcTcId (Located (body GhcTcId)))
+ -> TcM (GRHS GhcTc (Located (body GhcTc)))
tcGRHS ctxt res_ty (GRHS _ guards rhs)
= do { (guards', rhs')
@@ -307,7 +307,7 @@ tcGRHS ctxt res_ty (GRHS _ guards rhs)
tcDoStmts :: HsStmtContext GhcRn
-> Located [LStmt GhcRn (LHsExpr GhcRn)]
-> ExpRhoType
- -> TcM (HsExpr GhcTcId) -- Returns a HsDo
+ -> TcM (HsExpr GhcTc) -- Returns a HsDo
tcDoStmts ListComp (L l stmts) res_ty
= do { res_ty <- expTypeToType res_ty
; (co, elt_ty) <- matchExpectedListTy res_ty
@@ -333,7 +333,7 @@ tcDoStmts MonadComp (L l stmts) res_ty
tcDoStmts ctxt _ _ = pprPanic "tcDoStmts" (pprStmtContext ctxt)
-tcBody :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTcId)
+tcBody :: LHsExpr GhcRn -> ExpRhoType -> TcM (LHsExpr GhcTc)
tcBody body res_ty
= do { traceTc "tcBody" (ppr res_ty)
; tcMonoExpr body res_ty
@@ -355,13 +355,13 @@ type TcStmtChecker body rho_type
-> Stmt GhcRn (Located (body GhcRn))
-> rho_type -- Result type for comprehension
-> (rho_type -> TcM thing) -- Checker for what follows the stmt
- -> TcM (Stmt GhcTcId (Located (body GhcTcId)), thing)
+ -> TcM (Stmt GhcTc (Located (body GhcTc)), thing)
tcStmts :: (Outputable (body GhcRn)) => HsStmtContext GhcRn
-> TcStmtChecker body rho_type -- NB: higher-rank type
-> [LStmt GhcRn (Located (body GhcRn))]
-> rho_type
- -> TcM [LStmt GhcTcId (Located (body GhcTcId))]
+ -> TcM [LStmt GhcTc (Located (body GhcTc))]
tcStmts ctxt stmt_chk stmts res_ty
= do { (stmts', _) <- tcStmtsAndThen ctxt stmt_chk stmts res_ty $
const (return ())
@@ -372,7 +372,7 @@ tcStmtsAndThen :: (Outputable (body GhcRn)) => HsStmtContext GhcRn
-> [LStmt GhcRn (Located (body GhcRn))]
-> rho_type
-> (rho_type -> TcM thing)
- -> TcM ([LStmt GhcTcId (Located (body GhcTcId))], thing)
+ -> TcM ([LStmt GhcTc (Located (body GhcTc))], thing)
-- Note the higher-rank type. stmt_chk is applied at different
-- types in the equations for tcStmts
@@ -473,7 +473,7 @@ tcLcStmt m_tc ctxt (ParStmt _ bndr_stmts_s _ _) elt_ty thing_inside
; return (ParStmt unitTy pairs' noExpr noSyntaxExpr, thing) }
where
-- loop :: [([LStmt GhcRn], [GhcRn])]
- -- -> TcM ([([LStmt GhcTcId], [GhcTcId])], thing)
+ -- -> TcM ([([LStmt GhcTc], [GhcTc])], thing)
loop [] = do { thing <- thing_inside elt_ty
; return ([], thing) } -- matching in the branches
@@ -798,7 +798,7 @@ tcMcStmt ctxt (ParStmt _ bndr_stmts_s mzip_op bind_op) res_ty thing_inside
-- -> ExpRhoType -- inner_res_ty
-- -> [TcType] -- tup_tys
-- -> [ParStmtBlock Name]
- -- -> TcM ([([LStmt GhcTcId], [GhcTcId])], thing)
+ -- -> TcM ([([LStmt GhcTc], [TcId])], thing)
loop _ inner_res_ty [] [] = do { thing <- thing_inside inner_res_ty
; return ([], thing) }
-- matching in the branches
@@ -951,10 +951,10 @@ tcDoStmt _ stmt _ _
-- "GHC.Tc.Errors".
tcMonadFailOp :: CtOrigin
- -> LPat GhcTcId
+ -> LPat GhcTc
-> SyntaxExpr GhcRn -- The fail op
-> TcType -- Type of the whole do-expression
- -> TcRn (FailOperator GhcTcId) -- Typechecked fail op
+ -> TcRn (FailOperator GhcTc) -- Typechecked fail op
-- Get a 'fail' operator expression, to use if the pattern match fails.
-- This won't be used in cases where we've already determined the pattern
-- match can't fail (so the fail op is Nothing), however, it seems that the
@@ -1001,7 +1001,7 @@ tcApplicativeStmts
-> [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
-> ExpRhoType -- rhs_ty
-> (TcRhoType -> TcM t) -- thing_inside
- -> TcM ([(SyntaxExpr GhcTcId, ApplicativeArg GhcTcId)], Type, t)
+ -> TcM ([(SyntaxExpr GhcTc, ApplicativeArg GhcTc)], Type, t)
tcApplicativeStmts ctxt pairs rhs_ty thing_inside
= do { body_ty <- newFlexiTyVarTy liftedTypeKind
@@ -1040,7 +1040,7 @@ tcApplicativeStmts ctxt pairs rhs_ty thing_inside
; return (op' : ops') }
goArg :: Type -> (ApplicativeArg GhcRn, Type, Type)
- -> TcM (ApplicativeArg GhcTcId)
+ -> TcM (ApplicativeArg GhcTc)
goArg body_ty (ApplicativeArgOne
{ xarg_app_arg_one = fail_op
@@ -1074,7 +1074,7 @@ tcApplicativeStmts ctxt pairs rhs_ty thing_inside
}
; return (ApplicativeArgMany x stmts' ret' pat') }
- get_arg_bndrs :: ApplicativeArg GhcTcId -> [Id]
+ get_arg_bndrs :: ApplicativeArg GhcTc -> [Id]
get_arg_bndrs (ApplicativeArgOne { app_arg_pattern = pat }) = collectPatBinders pat
get_arg_bndrs (ApplicativeArgMany { bv_pattern = pat }) = collectPatBinders pat
=====================================
compiler/GHC/Tc/Gen/Match.hs-boot
=====================================
@@ -5,13 +5,13 @@ import GHC.Types.Name ( Name )
import GHC.Tc.Utils.TcType( ExpSigmaType, TcRhoType )
import GHC.Tc.Types ( TcM )
import GHC.Types.SrcLoc ( Located )
-import GHC.Hs.Extension ( GhcRn, GhcTcId )
+import GHC.Hs.Extension ( GhcRn, GhcTc )
tcGRHSsPat :: GRHSs GhcRn (LHsExpr GhcRn)
-> TcRhoType
- -> TcM (GRHSs GhcTcId (LHsExpr GhcTcId))
+ -> TcM (GRHSs GhcTc (LHsExpr GhcTc))
tcMatchesFun :: Located Name
-> MatchGroup GhcRn (LHsExpr GhcRn)
-> ExpSigmaType
- -> TcM (HsWrapper, MatchGroup GhcTcId (LHsExpr GhcTcId))
+ -> TcM (HsWrapper, MatchGroup GhcTc (LHsExpr GhcTc))
=====================================
compiler/GHC/Tc/Gen/Pat.hs
=====================================
@@ -80,7 +80,7 @@ tcLetPat :: (Name -> Maybe TcId)
-> LetBndrSpec
-> LPat GhcRn -> Scaled ExpSigmaType
-> TcM a
- -> TcM (LPat GhcTcId, a)
+ -> TcM (LPat GhcTc, a)
tcLetPat sig_fn no_gen pat pat_ty thing_inside
= do { bind_lvl <- getTcLevel
; let ctxt = LetPat { pc_lvl = bind_lvl
@@ -97,7 +97,7 @@ tcPats :: HsMatchContext GhcRn
-> [LPat GhcRn] -- Patterns,
-> [Scaled ExpSigmaType] -- and their types
-> TcM a -- and the checker for the body
- -> TcM ([LPat GhcTcId], a)
+ -> TcM ([LPat GhcTc], a)
-- This is the externally-callable wrapper function
-- Typecheck the patterns, extend the environment to bind the variables,
@@ -117,7 +117,7 @@ tcPats ctxt pats pat_tys thing_inside
tcInferPat :: HsMatchContext GhcRn -> LPat GhcRn
-> TcM a
- -> TcM ((LPat GhcTcId, a), TcSigmaType)
+ -> TcM ((LPat GhcTc, a), TcSigmaType)
tcInferPat ctxt pat thing_inside
= tcInfer $ \ exp_ty ->
tc_lpat (unrestricted exp_ty) penv pat thing_inside
@@ -127,7 +127,7 @@ tcInferPat ctxt pat thing_inside
tcCheckPat :: HsMatchContext GhcRn
-> LPat GhcRn -> Scaled TcSigmaType
-> TcM a -- Checker for body
- -> TcM (LPat GhcTcId, a)
+ -> TcM (LPat GhcTc, a)
tcCheckPat ctxt = tcCheckPat_O ctxt PatOrigin
-- | A variant of 'tcPat' that takes a custom origin
@@ -135,7 +135,7 @@ tcCheckPat_O :: HsMatchContext GhcRn
-> CtOrigin -- ^ origin to use if the type needs inst'ing
-> LPat GhcRn -> Scaled TcSigmaType
-> TcM a -- Checker for body
- -> TcM (LPat GhcTcId, a)
+ -> TcM (LPat GhcTc, a)
tcCheckPat_O ctxt orig pat (Scaled pat_mult pat_ty) thing_inside
= tc_lpat (Scaled pat_mult (mkCheckExpType pat_ty)) penv pat thing_inside
where
@@ -326,7 +326,7 @@ tcMultiple tc_pat penv args thing_inside
--------------------
tc_lpat :: Scaled ExpSigmaType
- -> Checker (LPat GhcRn) (LPat GhcTcId)
+ -> Checker (LPat GhcRn) (LPat GhcTc)
tc_lpat pat_ty penv (L span pat) thing_inside
= setSrcSpan span $
do { (pat', res) <- maybeWrapPatCtxt pat (tc_pat pat_ty penv pat)
@@ -334,7 +334,7 @@ tc_lpat pat_ty penv (L span pat) thing_inside
; return (L span pat', res) }
tc_lpats :: [Scaled ExpSigmaType]
- -> Checker [LPat GhcRn] [LPat GhcTcId]
+ -> Checker [LPat GhcRn] [LPat GhcTc]
tc_lpats tys penv pats
= ASSERT2( equalLength pats tys, ppr pats $$ ppr tys )
tcMultiple (\ penv' (p,t) -> tc_lpat t penv' p)
@@ -348,7 +348,7 @@ checkManyPattern pat_ty = tcSubMult NonLinearPatternOrigin Many (scaledMult pat_
tc_pat :: Scaled ExpSigmaType
-- ^ Fully refined result type
- -> Checker (Pat GhcRn) (Pat GhcTcId)
+ -> Checker (Pat GhcRn) (Pat GhcTc)
-- ^ Translated pattern
tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of
@@ -849,7 +849,7 @@ to express the local scope of GADT refinements.
tcConPat :: PatEnv -> Located Name
-> Scaled ExpSigmaType -- Type of the pattern
-> HsConPatDetails GhcRn -> TcM a
- -> TcM (Pat GhcTcId, a)
+ -> TcM (Pat GhcTc, a)
tcConPat penv con_lname@(L _ con_name) pat_ty arg_pats thing_inside
= do { con_like <- tcLookupConLike con_name
; case con_like of
@@ -862,7 +862,7 @@ tcConPat penv con_lname@(L _ con_name) pat_ty arg_pats thing_inside
tcDataConPat :: PatEnv -> Located Name -> DataCon
-> Scaled ExpSigmaType -- Type of the pattern
-> HsConPatDetails GhcRn -> TcM a
- -> TcM (Pat GhcTcId, a)
+ -> TcM (Pat GhcTc, a)
tcDataConPat penv (L con_span con_name) data_con pat_ty_scaled
arg_pats thing_inside
= do { let tycon = dataConTyCon data_con
@@ -967,7 +967,7 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty_scaled
tcPatSynPat :: PatEnv -> Located Name -> PatSyn
-> Scaled ExpSigmaType -- Type of the pattern
-> HsConPatDetails GhcRn -> TcM a
- -> TcM (Pat GhcTcId, a)
+ -> TcM (Pat GhcTc, a)
tcPatSynPat penv (L con_span _) pat_syn pat_ty arg_pats thing_inside
= do { let (univ_tvs, req_theta, ex_tvs, prov_theta, arg_tys, ty) = patSynSig pat_syn
@@ -1143,7 +1143,7 @@ tcConArgs con_like arg_tys penv con_args thing_inside = case con_args of
; return (RecCon (HsRecFields rpats' dd), res) }
where
tc_field :: Checker (LHsRecField GhcRn (LPat GhcRn))
- (LHsRecField GhcTcId (LPat GhcTcId))
+ (LHsRecField GhcTc (LPat GhcTc))
tc_field penv
(L l (HsRecField (L loc (FieldOcc sel (L lr rdr))) pat pun))
thing_inside
=====================================
compiler/GHC/Tc/Gen/Rule.hs
=====================================
@@ -98,10 +98,10 @@ explains a very similar design when generalising over a type family instance
equation.
-}
-tcRules :: [LRuleDecls GhcRn] -> TcM [LRuleDecls GhcTcId]
+tcRules :: [LRuleDecls GhcRn] -> TcM [LRuleDecls GhcTc]
tcRules decls = mapM (wrapLocM tcRuleDecls) decls
-tcRuleDecls :: RuleDecls GhcRn -> TcM (RuleDecls GhcTcId)
+tcRuleDecls :: RuleDecls GhcRn -> TcM (RuleDecls GhcTc)
tcRuleDecls (HsRules { rds_src = src
, rds_rules = decls })
= do { tc_decls <- mapM (wrapLocM tcRule) decls
@@ -109,7 +109,7 @@ tcRuleDecls (HsRules { rds_src = src
, rds_src = src
, rds_rules = tc_decls } }
-tcRule :: RuleDecl GhcRn -> TcM (RuleDecl GhcTcId)
+tcRule :: RuleDecl GhcRn -> TcM (RuleDecl GhcTc)
tcRule (HsRule { rd_ext = ext
, rd_name = rname@(L _ (_,name))
, rd_act = act
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -151,10 +151,10 @@ import Data.Proxy ( Proxy (..) )
************************************************************************
-}
-tcTypedBracket :: HsExpr GhcRn -> HsBracket GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId)
+tcTypedBracket :: HsExpr GhcRn -> HsBracket GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
tcUntypedBracket :: HsExpr GhcRn -> HsBracket GhcRn -> [PendingRnSplice] -> ExpRhoType
- -> TcM (HsExpr GhcTcId)
-tcSpliceExpr :: HsSplice GhcRn -> ExpRhoType -> TcM (HsExpr GhcTcId)
+ -> TcM (HsExpr GhcTc)
+tcSpliceExpr :: HsSplice GhcRn -> ExpRhoType -> TcM (HsExpr GhcTc)
-- None of these functions add constraints to the LIE
-- runQuasiQuoteExpr :: HsQuasiQuote RdrName -> RnM (LHsExpr RdrName)
=====================================
compiler/GHC/Tc/Gen/Splice.hs-boot
=====================================
@@ -9,7 +9,7 @@ import GHC.Hs.Expr ( PendingRnSplice, DelayedSplice )
import GHC.Tc.Types( TcM , SpliceType )
import GHC.Tc.Utils.TcType ( ExpRhoType )
import GHC.Types.Annotations ( Annotation, CoreAnnTarget )
-import GHC.Hs.Extension ( GhcTcId, GhcRn, GhcPs, GhcTc )
+import GHC.Hs.Extension ( GhcRn, GhcPs, GhcTc )
import GHC.Hs ( HsSplice, HsBracket, HsExpr, LHsExpr, LHsType, LPat,
LHsDecl, ThModFinalizers )
@@ -17,28 +17,28 @@ import qualified Language.Haskell.TH as TH
tcSpliceExpr :: HsSplice GhcRn
-> ExpRhoType
- -> TcM (HsExpr GhcTcId)
+ -> TcM (HsExpr GhcTc)
tcUntypedBracket :: HsExpr GhcRn
-> HsBracket GhcRn
-> [PendingRnSplice]
-> ExpRhoType
- -> TcM (HsExpr GhcTcId)
+ -> TcM (HsExpr GhcTc)
tcTypedBracket :: HsExpr GhcRn
-> HsBracket GhcRn
-> ExpRhoType
- -> TcM (HsExpr GhcTcId)
+ -> TcM (HsExpr GhcTc)
runTopSplice :: DelayedSplice -> TcM (HsExpr GhcTc)
runAnnotation :: CoreAnnTarget -> LHsExpr GhcRn -> TcM Annotation
-tcTopSpliceExpr :: SpliceType -> TcM (LHsExpr GhcTcId) -> TcM (LHsExpr GhcTcId)
+tcTopSpliceExpr :: SpliceType -> TcM (LHsExpr GhcTc) -> TcM (LHsExpr GhcTc)
-runMetaE :: LHsExpr GhcTcId -> TcM (LHsExpr GhcPs)
-runMetaP :: LHsExpr GhcTcId -> TcM (LPat GhcPs)
-runMetaT :: LHsExpr GhcTcId -> TcM (LHsType GhcPs)
-runMetaD :: LHsExpr GhcTcId -> TcM [LHsDecl GhcPs]
+runMetaE :: LHsExpr GhcTc -> TcM (LHsExpr GhcPs)
+runMetaP :: LHsExpr GhcTc -> TcM (LPat GhcPs)
+runMetaT :: LHsExpr GhcTc -> TcM (LHsType GhcPs)
+runMetaD :: LHsExpr GhcTc -> TcM [LHsDecl GhcPs]
lookupThName_maybe :: TH.Name -> TcM (Maybe Name)
runQuasi :: TH.Q a -> TcM a
=====================================
compiler/GHC/Tc/TyCl/Class.hs
=====================================
@@ -184,7 +184,7 @@ tcClassSigs clas sigs def_methods
-}
tcClassDecl2 :: LTyClDecl GhcRn -- The class declaration
- -> TcM (LHsBinds GhcTcId)
+ -> TcM (LHsBinds GhcTc)
tcClassDecl2 (L _ (ClassDecl {tcdLName = class_name, tcdSigs = sigs,
tcdMeths = default_binds}))
@@ -218,7 +218,7 @@ tcClassDecl2 d = pprPanic "tcClassDecl2" (ppr d)
tcDefMeth :: Class -> [TyVar] -> EvVar -> LHsBinds GhcRn
-> HsSigFun -> TcPragEnv -> ClassOpItem
- -> TcM (LHsBinds GhcTcId)
+ -> TcM (LHsBinds GhcTc)
-- Generate code for default methods
-- This is incompatible with Hugs, which expects a polymorphic
-- default method for every class op, regardless of whether or not
=====================================
compiler/GHC/Tc/TyCl/Instance.hs
=====================================
@@ -1775,7 +1775,7 @@ tcMethodBody clas tyvars dfun_ev_vars inst_tys
| otherwise = thing
tcMethodBodyHelp :: HsSigFun -> Id -> TcId
- -> LHsBind GhcRn -> TcM (LHsBinds GhcTcId)
+ -> LHsBind GhcRn -> TcM (LHsBinds GhcTc)
tcMethodBodyHelp hs_sig_fn sel_id local_meth_id meth_bind
| Just hs_sig_ty <- hs_sig_fn sel_name
-- There is a signature in the instance
=====================================
compiler/GHC/Tc/TyCl/PatSyn.hs
=====================================
@@ -427,7 +427,7 @@ tcCheckPatSynDecl psb at PSB{ psb_id = lname@(L _ name), psb_args = details
(args', (map scaledThing arg_tys))
pat_ty rec_fields }
where
- tc_arg :: TCvSubst -> Name -> Type -> TcM (LHsExpr GhcTcId)
+ tc_arg :: TCvSubst -> Name -> Type -> TcM (LHsExpr GhcTc)
tc_arg subst arg_name arg_ty
= do { -- Look up the variable actually bound by lpat
-- and check that it has the expected type
@@ -597,8 +597,7 @@ tc_patsyn_finish :: Located Name -- ^ PatSyn Name
-> LPat GhcTc -- ^ Pattern of the PatSyn
-> ([TcInvisTVBinder], [PredType], TcEvBinds, [EvVar])
-> ([TcInvisTVBinder], [TcType], [PredType], [EvTerm])
- -> ([LHsExpr GhcTcId], [TcType]) -- ^ Pattern arguments and
- -- types
+ -> ([LHsExpr GhcTc], [TcType]) -- ^ Pattern arguments and types
-> TcType -- ^ Pattern type
-> [Name] -- ^ Selector names
-- ^ Whether fields, empty if not record PatSyn
@@ -683,7 +682,7 @@ tcPatSynMatcher :: Located Name
-> LPat GhcTc
-> ([TcTyVar], ThetaType, TcEvBinds, [EvVar])
-> ([TcTyVar], [TcType], ThetaType, [EvTerm])
- -> ([LHsExpr GhcTcId], [TcType])
+ -> ([LHsExpr GhcTc], [TcType])
-> TcType
-> TcM ((Id, Bool), LHsBinds GhcTc)
-- See Note [Matchers and builders for pattern synonyms] in GHC.Core.PatSyn
@@ -885,7 +884,7 @@ tcPatSynBuilderBind (PSB { psb_id = L loc name
add_dummy_arg other_mg = pprPanic "add_dummy_arg" $
pprMatches other_mg
-tcPatSynBuilderOcc :: PatSyn -> TcM (HsExpr GhcTcId, TcSigmaType)
+tcPatSynBuilderOcc :: PatSyn -> TcM (HsExpr GhcTc, TcSigmaType)
-- monadic only for failure
tcPatSynBuilderOcc ps
| Just (builder_id, add_void_arg) <- builder
=====================================
compiler/GHC/Tc/Utils/Instantiate.hs
=====================================
@@ -90,7 +90,7 @@ newMethodFromName
:: CtOrigin -- ^ why do we need this?
-> Name -- ^ name of the method
-> [TcRhoType] -- ^ types with which to instantiate the class
- -> TcM (HsExpr GhcTcId)
+ -> TcM (HsExpr GhcTc)
-- ^ Used when 'Name' is the wired-in name for a wired-in class method,
-- so the caller knows its type for sure, which should be of form
--
@@ -464,7 +464,7 @@ cases (the rest are caught in lookupInst).
newOverloadedLit :: HsOverLit GhcRn
-> ExpRhoType
- -> TcM (HsOverLit GhcTcId)
+ -> TcM (HsOverLit GhcTc)
newOverloadedLit
lit@(OverLit { ol_val = val, ol_ext = rebindable }) res_ty
| not rebindable
@@ -493,7 +493,7 @@ newOverloadedLit
newNonTrivialOverloadedLit :: CtOrigin
-> HsOverLit GhcRn
-> ExpRhoType
- -> TcM (HsOverLit GhcTcId)
+ -> TcM (HsOverLit GhcTc)
newNonTrivialOverloadedLit orig
lit@(OverLit { ol_val = val, ol_witness = HsVar _ (L _ meth_name)
, ol_ext = rebindable }) res_ty
@@ -557,7 +557,7 @@ just use the expression inline.
tcSyntaxName :: CtOrigin
-> TcType -- ^ Type to instantiate it at
-> (Name, HsExpr GhcRn) -- ^ (Standard name, user name)
- -> TcM (Name, HsExpr GhcTcId)
+ -> TcM (Name, HsExpr GhcTc)
-- ^ (Standard name, suitable expression)
-- USED ONLY FOR CmdTop (sigh) ***
-- See Note [CmdSyntaxTable] in GHC.Hs.Expr
=====================================
compiler/GHC/Tc/Utils/Unify.hs
=====================================
@@ -510,22 +510,22 @@ expected_ty.
-----------------
-- tcWrapResult needs both un-type-checked (for origins and error messages)
-- and type-checked (for wrapping) expressions
-tcWrapResult :: HsExpr GhcRn -> HsExpr GhcTcId -> TcSigmaType -> ExpRhoType
- -> TcM (HsExpr GhcTcId)
+tcWrapResult :: HsExpr GhcRn -> HsExpr GhcTc -> TcSigmaType -> ExpRhoType
+ -> TcM (HsExpr GhcTc)
tcWrapResult rn_expr = tcWrapResultO (exprCtOrigin rn_expr) rn_expr
-tcWrapResultO :: CtOrigin -> HsExpr GhcRn -> HsExpr GhcTcId -> TcSigmaType -> ExpRhoType
- -> TcM (HsExpr GhcTcId)
+tcWrapResultO :: CtOrigin -> HsExpr GhcRn -> HsExpr GhcTc -> TcSigmaType -> ExpRhoType
+ -> TcM (HsExpr GhcTc)
tcWrapResultO orig rn_expr expr actual_ty res_ty
= do { traceTc "tcWrapResult" (vcat [ text "Actual: " <+> ppr actual_ty
, text "Expected:" <+> ppr res_ty ])
; wrap <- tcSubTypeNC orig GenSigCtxt (Just rn_expr) actual_ty res_ty
; return (mkHsWrap wrap expr) }
-tcWrapResultMono :: HsExpr GhcRn -> HsExpr GhcTcId
+tcWrapResultMono :: HsExpr GhcRn -> HsExpr GhcTc
-> TcRhoType -- Actual -- a rho-type not a sigma-type
-> ExpRhoType -- Expected
- -> TcM (HsExpr GhcTcId)
+ -> TcM (HsExpr GhcTc)
-- A version of tcWrapResult to use when the actual type is a
-- rho-type, so nothing to instantiate; just go straight to unify.
-- It means we don't need to pass in a CtOrigin
=====================================
compiler/GHC/Tc/Utils/Zonk.hs
=====================================
@@ -144,7 +144,7 @@ hsLitType (HsDoublePrim _ _) = doublePrimTy
-- Overloaded literals. Here mainly because it uses isIntTy etc
-shortCutLit :: Platform -> OverLitVal -> TcType -> Maybe (HsExpr GhcTcId)
+shortCutLit :: Platform -> OverLitVal -> TcType -> Maybe (HsExpr GhcTc)
shortCutLit platform (HsIntegral int@(IL src neg i)) ty
| isIntTy ty && platformInIntRange platform i = Just (HsLit noExtField (HsInt noExtField int))
| isWordTy ty && platformInWordRange platform i = Just (mkLit wordDataCon (HsWordPrim src i))
@@ -385,7 +385,7 @@ zonkIdBndrs env ids = mapM (zonkIdBndr env) ids
zonkTopBndrs :: [TcId] -> TcM [Id]
zonkTopBndrs ids = initZonkEnv $ \ ze -> zonkIdBndrs ze ids
-zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTcId -> TcM (FieldOcc GhcTc)
+zonkFieldOcc :: ZonkEnv -> FieldOcc GhcTc -> TcM (FieldOcc GhcTc)
zonkFieldOcc env (FieldOcc sel lbl)
= fmap ((flip FieldOcc) lbl) $ zonkIdBndr env sel
@@ -457,16 +457,16 @@ zonkTyVarBinderX env (Bndr tv vis)
= do { (env', tv') <- zonkTyBndrX env tv
; return (env', Bndr tv' vis) }
-zonkTopExpr :: HsExpr GhcTcId -> TcM (HsExpr GhcTc)
+zonkTopExpr :: HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkTopExpr e = initZonkEnv $ \ ze -> zonkExpr ze e
-zonkTopLExpr :: LHsExpr GhcTcId -> TcM (LHsExpr GhcTc)
+zonkTopLExpr :: LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
zonkTopLExpr e = initZonkEnv $ \ ze -> zonkLExpr ze e
zonkTopDecls :: Bag EvBind
- -> LHsBinds GhcTcId
- -> [LRuleDecl GhcTcId] -> [LTcSpecPrag]
- -> [LForeignDecl GhcTcId]
+ -> LHsBinds GhcTc
+ -> [LRuleDecl GhcTc] -> [LTcSpecPrag]
+ -> [LForeignDecl GhcTc]
-> TcM (TypeEnv,
Bag EvBind,
LHsBinds GhcTc,
@@ -483,7 +483,7 @@ zonkTopDecls ev_binds binds rules imp_specs fords
; return (zonkEnvIds env2, ev_binds', binds', fords', specs', rules') }
---------------------------------------------
-zonkLocalBinds :: ZonkEnv -> HsLocalBinds GhcTcId
+zonkLocalBinds :: ZonkEnv -> HsLocalBinds GhcTc
-> TcM (ZonkEnv, HsLocalBinds GhcTc)
zonkLocalBinds env (EmptyLocalBinds x)
= return (env, (EmptyLocalBinds x))
@@ -516,7 +516,7 @@ zonkLocalBinds env (HsIPBinds x (IPBinds dict_binds binds )) = do
return (IPBind x n' e')
---------------------------------------------
-zonkRecMonoBinds :: ZonkEnv -> LHsBinds GhcTcId -> TcM (ZonkEnv, LHsBinds GhcTc)
+zonkRecMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (ZonkEnv, LHsBinds GhcTc)
zonkRecMonoBinds env binds
= fixM (\ ~(_, new_binds) -> do
{ let env1 = extendIdZonkEnvRec env (collectHsBindsBinders new_binds)
@@ -524,13 +524,13 @@ zonkRecMonoBinds env binds
; return (env1, binds') })
---------------------------------------------
-zonkMonoBinds :: ZonkEnv -> LHsBinds GhcTcId -> TcM (LHsBinds GhcTc)
+zonkMonoBinds :: ZonkEnv -> LHsBinds GhcTc -> TcM (LHsBinds GhcTc)
zonkMonoBinds env binds = mapBagM (zonk_lbind env) binds
-zonk_lbind :: ZonkEnv -> LHsBind GhcTcId -> TcM (LHsBind GhcTc)
+zonk_lbind :: ZonkEnv -> LHsBind GhcTc -> TcM (LHsBind GhcTc)
zonk_lbind env = wrapLocM (zonk_bind env)
-zonk_bind :: ZonkEnv -> HsBind GhcTcId -> TcM (HsBind GhcTc)
+zonk_bind :: ZonkEnv -> HsBind GhcTc -> TcM (HsBind GhcTc)
zonk_bind env bind@(PatBind { pat_lhs = pat, pat_rhs = grhss
, pat_ext = NPatBindTc fvs ty})
= do { (_env, new_pat) <- zonkPat env pat -- Env already extended
@@ -595,7 +595,7 @@ zonk_bind env (AbsBinds { abs_tvs = tyvars, abs_ev_vars = evs
| otherwise
= zonk_lbind env lbind -- The normal case
- zonk_export :: ZonkEnv -> ABExport GhcTcId -> TcM (ABExport GhcTc)
+ zonk_export :: ZonkEnv -> ABExport GhcTc -> TcM (ABExport GhcTc)
zonk_export env (ABE{ abe_ext = x
, abe_wrap = wrap
, abe_poly = poly_id
@@ -634,7 +634,7 @@ zonkPatSynDetails env (InfixCon a1 a2)
zonkPatSynDetails env (RecCon flds)
= RecCon (map (fmap (zonkLIdOcc env)) flds)
-zonkPatSynDir :: ZonkEnv -> HsPatSynDir GhcTcId
+zonkPatSynDir :: ZonkEnv -> HsPatSynDir GhcTc
-> TcM (ZonkEnv, HsPatSynDir GhcTc)
zonkPatSynDir env Unidirectional = return (env, Unidirectional)
zonkPatSynDir env ImplicitBidirectional = return (env, ImplicitBidirectional)
@@ -664,8 +664,8 @@ zonkLTcSpecPrags env ps
-}
zonkMatchGroup :: ZonkEnv
- -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
- -> MatchGroup GhcTcId (Located (body GhcTcId))
+ -> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
+ -> MatchGroup GhcTc (Located (body GhcTc))
-> TcM (MatchGroup GhcTc (Located (body GhcTc)))
zonkMatchGroup env zBody (MG { mg_alts = L l ms
, mg_ext = MatchGroupTc arg_tys res_ty
@@ -678,8 +678,8 @@ zonkMatchGroup env zBody (MG { mg_alts = L l ms
, mg_origin = origin }) }
zonkMatch :: ZonkEnv
- -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
- -> LMatch GhcTcId (Located (body GhcTcId))
+ -> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
+ -> LMatch GhcTc (Located (body GhcTc))
-> TcM (LMatch GhcTc (Located (body GhcTc)))
zonkMatch env zBody (L loc match@(Match { m_pats = pats
, m_grhss = grhss }))
@@ -689,8 +689,8 @@ zonkMatch env zBody (L loc match@(Match { m_pats = pats
-------------------------------------------------------------------------
zonkGRHSs :: ZonkEnv
- -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
- -> GRHSs GhcTcId (Located (body GhcTcId))
+ -> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
+ -> GRHSs GhcTc (Located (body GhcTc))
-> TcM (GRHSs GhcTc (Located (body GhcTc)))
zonkGRHSs env zBody (GRHSs x grhss (L l binds)) = do
@@ -711,9 +711,9 @@ zonkGRHSs env zBody (GRHSs x grhss (L l binds)) = do
************************************************************************
-}
-zonkLExprs :: ZonkEnv -> [LHsExpr GhcTcId] -> TcM [LHsExpr GhcTc]
-zonkLExpr :: ZonkEnv -> LHsExpr GhcTcId -> TcM (LHsExpr GhcTc)
-zonkExpr :: ZonkEnv -> HsExpr GhcTcId -> TcM (HsExpr GhcTc)
+zonkLExprs :: ZonkEnv -> [LHsExpr GhcTc] -> TcM [LHsExpr GhcTc]
+zonkLExpr :: ZonkEnv -> LHsExpr GhcTc -> TcM (LHsExpr GhcTc)
+zonkExpr :: ZonkEnv -> HsExpr GhcTc -> TcM (HsExpr GhcTc)
zonkLExprs env exprs = mapM (zonkLExpr env) exprs
zonkLExpr env expr = wrapLocM (zonkExpr env) expr
@@ -939,7 +939,7 @@ Now, we can safely just extend one environment.
-}
-- See Note [Skolems in zonkSyntaxExpr]
-zonkSyntaxExpr :: ZonkEnv -> SyntaxExpr GhcTcId
+zonkSyntaxExpr :: ZonkEnv -> SyntaxExpr GhcTc
-> TcM (ZonkEnv, SyntaxExpr GhcTc)
zonkSyntaxExpr env (SyntaxExprTc { syn_expr = expr
, syn_arg_wraps = arg_wraps
@@ -954,8 +954,8 @@ zonkSyntaxExpr env NoSyntaxExprTc = return (env, NoSyntaxExprTc)
-------------------------------------------------------------------------
-zonkLCmd :: ZonkEnv -> LHsCmd GhcTcId -> TcM (LHsCmd GhcTc)
-zonkCmd :: ZonkEnv -> HsCmd GhcTcId -> TcM (HsCmd GhcTc)
+zonkLCmd :: ZonkEnv -> LHsCmd GhcTc -> TcM (LHsCmd GhcTc)
+zonkCmd :: ZonkEnv -> HsCmd GhcTc -> TcM (HsCmd GhcTc)
zonkLCmd env cmd = wrapLocM (zonkCmd env) cmd
@@ -1015,10 +1015,10 @@ zonkCmd env (HsCmdDo ty (L l stmts))
-zonkCmdTop :: ZonkEnv -> LHsCmdTop GhcTcId -> TcM (LHsCmdTop GhcTc)
+zonkCmdTop :: ZonkEnv -> LHsCmdTop GhcTc -> TcM (LHsCmdTop GhcTc)
zonkCmdTop env cmd = wrapLocM (zonk_cmd_top env) cmd
-zonk_cmd_top :: ZonkEnv -> HsCmdTop GhcTcId -> TcM (HsCmdTop GhcTc)
+zonk_cmd_top :: ZonkEnv -> HsCmdTop GhcTc -> TcM (HsCmdTop GhcTc)
zonk_cmd_top env (HsCmdTop (CmdTopTc stack_tys ty ids) cmd)
= do new_cmd <- zonkLCmd env cmd
new_stack_tys <- zonkTcTypeToTypeX env stack_tys
@@ -1059,14 +1059,14 @@ zonkCoFn env (WpMultCoercion co) = do { co' <- zonkCoToCo env co
; return (env, WpMultCoercion co') }
-------------------------------------------------------------------------
-zonkOverLit :: ZonkEnv -> HsOverLit GhcTcId -> TcM (HsOverLit GhcTc)
+zonkOverLit :: ZonkEnv -> HsOverLit GhcTc -> TcM (HsOverLit GhcTc)
zonkOverLit env lit@(OverLit {ol_ext = OverLitTc r ty, ol_witness = e })
= do { ty' <- zonkTcTypeToTypeX env ty
; e' <- zonkExpr env e
; return (lit { ol_witness = e', ol_ext = OverLitTc r ty' }) }
-------------------------------------------------------------------------
-zonkArithSeq :: ZonkEnv -> ArithSeqInfo GhcTcId -> TcM (ArithSeqInfo GhcTc)
+zonkArithSeq :: ZonkEnv -> ArithSeqInfo GhcTc -> TcM (ArithSeqInfo GhcTc)
zonkArithSeq env (From e)
= do new_e <- zonkLExpr env e
@@ -1091,8 +1091,8 @@ zonkArithSeq env (FromThenTo e1 e2 e3)
-------------------------------------------------------------------------
zonkStmts :: ZonkEnv
- -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
- -> [LStmt GhcTcId (Located (body GhcTcId))]
+ -> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
+ -> [LStmt GhcTc (Located (body GhcTc))]
-> TcM (ZonkEnv, [LStmt GhcTc (Located (body GhcTc))])
zonkStmts env _ [] = return (env, [])
zonkStmts env zBody (s:ss) = do { (env1, s') <- wrapLocSndM (zonkStmt env zBody) s
@@ -1100,8 +1100,8 @@ zonkStmts env zBody (s:ss) = do { (env1, s') <- wrapLocSndM (zonkStmt env zBody
; return (env2, s' : ss') }
zonkStmt :: ZonkEnv
- -> (ZonkEnv -> Located (body GhcTcId) -> TcM (Located (body GhcTc)))
- -> Stmt GhcTcId (Located (body GhcTcId))
+ -> (ZonkEnv -> Located (body GhcTc) -> TcM (Located (body GhcTc)))
+ -> Stmt GhcTc (Located (body GhcTc))
-> TcM (ZonkEnv, Stmt GhcTc (Located (body GhcTc)))
zonkStmt env _ (ParStmt bind_ty stmts_w_bndrs mzip_op bind_op)
= do { (env1, new_bind_op) <- zonkSyntaxExpr env bind_op
@@ -1114,7 +1114,7 @@ zonkStmt env _ (ParStmt bind_ty stmts_w_bndrs mzip_op bind_op)
; return (env2
, ParStmt new_bind_ty new_stmts_w_bndrs new_mzip new_bind_op)}
where
- zonk_branch :: ZonkEnv -> ParStmtBlock GhcTcId GhcTcId
+ zonk_branch :: ZonkEnv -> ParStmtBlock GhcTc GhcTc
-> TcM (ParStmtBlock GhcTc GhcTc)
zonk_branch env1 (ParStmtBlock x stmts bndrs return_op)
= do { (env2, new_stmts) <- zonkStmts env1 zonkLExpr stmts
@@ -1226,11 +1226,11 @@ zonkStmt env _zBody (ApplicativeStmt body_ty args mb_join)
zonk_join env Nothing = return (env, Nothing)
zonk_join env (Just j) = second Just <$> zonkSyntaxExpr env j
- get_pat :: (SyntaxExpr GhcTcId, ApplicativeArg GhcTcId) -> LPat GhcTcId
+ get_pat :: (SyntaxExpr GhcTc, ApplicativeArg GhcTc) -> LPat GhcTc
get_pat (_, ApplicativeArgOne _ pat _ _) = pat
get_pat (_, ApplicativeArgMany _ _ _ pat) = pat
- replace_pat :: LPat GhcTcId
+ replace_pat :: LPat GhcTc
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
-> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
replace_pat pat (op, ApplicativeArgOne fail_op _ a isBody)
@@ -1267,7 +1267,7 @@ zonkStmt env _zBody (ApplicativeStmt body_ty args mb_join)
; return (ApplicativeArgMany x new_stmts new_ret pat) }
-------------------------------------------------------------------------
-zonkRecFields :: ZonkEnv -> HsRecordBinds GhcTcId -> TcM (HsRecordBinds GhcTcId)
+zonkRecFields :: ZonkEnv -> HsRecordBinds GhcTc -> TcM (HsRecordBinds GhcTc)
zonkRecFields env (HsRecFields flds dd)
= do { flds' <- mapM zonk_rbind flds
; return (HsRecFields flds' dd) }
@@ -1278,8 +1278,8 @@ zonkRecFields env (HsRecFields flds dd)
; return (L l (fld { hsRecFieldLbl = new_id
, hsRecFieldArg = new_expr })) }
-zonkRecUpdFields :: ZonkEnv -> [LHsRecUpdField GhcTcId]
- -> TcM [LHsRecUpdField GhcTcId]
+zonkRecUpdFields :: ZonkEnv -> [LHsRecUpdField GhcTc]
+ -> TcM [LHsRecUpdField GhcTc]
zonkRecUpdFields env = mapM zonk_rbind
where
zonk_rbind (L l fld)
@@ -1309,7 +1309,7 @@ zonkPat :: ZonkEnv -> LPat GhcTc -> TcM (ZonkEnv, LPat GhcTc)
-- to the right)
zonkPat env pat = wrapLocSndM (zonk_pat env) pat
-zonk_pat :: ZonkEnv -> Pat GhcTcId -> TcM (ZonkEnv, Pat GhcTc)
+zonk_pat :: ZonkEnv -> Pat GhcTc -> TcM (ZonkEnv, Pat GhcTc)
zonk_pat env (ParPat x p)
= do { (env', p') <- zonkPat env p
; return (env', ParPat x p') }
@@ -1483,11 +1483,11 @@ zonkPats env (pat:pats) = do { (env1, pat') <- zonkPat env pat
************************************************************************
-}
-zonkForeignExports :: ZonkEnv -> [LForeignDecl GhcTcId]
+zonkForeignExports :: ZonkEnv -> [LForeignDecl GhcTc]
-> TcM [LForeignDecl GhcTc]
zonkForeignExports env ls = mapM (wrapLocM (zonkForeignExport env)) ls
-zonkForeignExport :: ZonkEnv -> ForeignDecl GhcTcId -> TcM (ForeignDecl GhcTc)
+zonkForeignExport :: ZonkEnv -> ForeignDecl GhcTc -> TcM (ForeignDecl GhcTc)
zonkForeignExport env (ForeignExport { fd_name = i, fd_e_ext = co
, fd_fe = spec })
= return (ForeignExport { fd_name = zonkLIdOcc env i
@@ -1496,10 +1496,10 @@ zonkForeignExport env (ForeignExport { fd_name = i, fd_e_ext = co
zonkForeignExport _ for_imp
= return for_imp -- Foreign imports don't need zonking
-zonkRules :: ZonkEnv -> [LRuleDecl GhcTcId] -> TcM [LRuleDecl GhcTc]
+zonkRules :: ZonkEnv -> [LRuleDecl GhcTc] -> TcM [LRuleDecl GhcTc]
zonkRules env rs = mapM (wrapLocM (zonkRule env)) rs
-zonkRule :: ZonkEnv -> RuleDecl GhcTcId -> TcM (RuleDecl GhcTc)
+zonkRule :: ZonkEnv -> RuleDecl GhcTc -> TcM (RuleDecl GhcTc)
zonkRule env rule@(HsRule { rd_tmvs = tm_bndrs{-::[RuleBndr TcId]-}
, rd_lhs = lhs
, rd_rhs = rhs })
@@ -1515,7 +1515,7 @@ zonkRule env rule@(HsRule { rd_tmvs = tm_bndrs{-::[RuleBndr TcId]-}
, rd_lhs = new_lhs
, rd_rhs = new_rhs } }
where
- zonk_tm_bndr :: ZonkEnv -> LRuleBndr GhcTcId -> TcM (ZonkEnv, LRuleBndr GhcTcId)
+ zonk_tm_bndr :: ZonkEnv -> LRuleBndr GhcTc -> TcM (ZonkEnv, LRuleBndr GhcTc)
zonk_tm_bndr env (L l (RuleBndr x (L loc v)))
= do { (env', v') <- zonk_it env v
; return (env', L l (RuleBndr x (L loc v'))) }
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59350f1883e5ecf350d22958511d30bd75d80a9f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/59350f1883e5ecf350d22958511d30bd75d80a9f
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20200623/3a582a82/attachment-0001.html>
More information about the ghc-commits
mailing list