summaryrefslogtreecommitdiff
path: root/compiler/GHC/Tc/Gen
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Tc/Gen')
-rw-r--r--compiler/GHC/Tc/Gen/Bind.hs14
-rw-r--r--compiler/GHC/Tc/Gen/Export.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Expr.hs4
-rw-r--r--compiler/GHC/Tc/Gen/Foreign.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Head.hs12
-rw-r--r--compiler/GHC/Tc/Gen/HsType.hs4
-rw-r--r--compiler/GHC/Tc/Gen/Pat.hs6
-rw-r--r--compiler/GHC/Tc/Gen/Rule.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Splice.hs2
9 files changed, 24 insertions, 24 deletions
diff --git a/compiler/GHC/Tc/Gen/Bind.hs b/compiler/GHC/Tc/Gen/Bind.hs
index 10e665051d..543bb2f472 100644
--- a/compiler/GHC/Tc/Gen/Bind.hs
+++ b/compiler/GHC/Tc/Gen/Bind.hs
@@ -211,7 +211,7 @@ tcCompleteSigs sigs =
-- compatible with the result type constructor 'mb_tc'.
doOne (L loc c@(CompleteMatchSig (_ext, _src_txt) (L _ ns) mb_tc_nm))
= fmap Just $ setSrcSpanA loc $ addErrCtxt (text "In" <+> ppr c) $ do
- cls <- mkUniqDSet <$> mapM (addLocMA tcLookupConLike) ns
+ cls <- mkUniqDSet <$> mapM (addLocMN tcLookupConLike) ns
mb_tc <- traverse @Maybe tcLookupLocatedTyCon mb_tc_nm
pure CompleteMatch { cmConLikes = cls, cmResultTyCon = mb_tc }
doOne _ = return Nothing
@@ -601,7 +601,7 @@ tcPolyCheck prag_fn
, fun_matches = matches }))
= do { traceTc "tcPolyCheck" (ppr poly_id $$ ppr sig_loc)
- ; mono_name <- newNameAt (nameOccName name) (locA nm_loc)
+ ; mono_name <- newNameAt (nameOccName name) (locN nm_loc)
; (wrap_gen, (wrap_res, matches'))
<- setSrcSpan sig_loc $ -- Sets the binding location for the skolems
tcSkolemiseScoped ctxt (idType poly_id) $ \rho_ty ->
@@ -631,7 +631,7 @@ tcPolyCheck prag_fn
; poly_id <- addInlinePrags poly_id prag_sigs
; mod <- getModule
- ; tick <- funBindTicks (locA nm_loc) poly_id mod prag_sigs
+ ; tick <- funBindTicks (locN nm_loc) poly_id mod prag_sigs
; let bind' = FunBind { fun_id = L nm_loc poly_id2
, fun_matches = matches'
@@ -1437,7 +1437,7 @@ tcLhs sig_fn no_gen (FunBind { fun_id = L nm_loc name
-- Just g = ...f...
-- Hence always typechecked with InferGen
do { mono_info <- tcLhsSigId no_gen (name, sig)
- ; return (TcFunBind mono_info (locA nm_loc) matches) }
+ ; return (TcFunBind mono_info (locN nm_loc) matches) }
| otherwise -- No type signature
= do { mono_ty <- newOpenFlexiTyVarTy
@@ -1448,7 +1448,7 @@ tcLhs sig_fn no_gen (FunBind { fun_id = L nm_loc name
; let mono_info = MBI { mbi_poly_name = name
, mbi_sig = Nothing
, mbi_mono_id = mono_id }
- ; return (TcFunBind mono_info (locA nm_loc) matches) }
+ ; return (TcFunBind mono_info (locN nm_loc) matches) }
tcLhs sig_fn no_gen (PatBind { pat_lhs = pat, pat_rhs = grhss })
= -- See Note [Typechecking pattern bindings]
@@ -1524,9 +1524,9 @@ tcRhs (TcFunBind info@(MBI { mbi_sig = mb_sig, mbi_mono_id = mono_id })
= tcExtendIdBinderStackForRhs [info] $
tcExtendTyVarEnvForRhs mb_sig $
do { traceTc "tcRhs: fun bind" (ppr mono_id $$ ppr (idType mono_id))
- ; (co_fn, matches') <- tcMatchesFun (L (noAnnSrcSpan loc) mono_id)
+ ; (co_fn, matches') <- tcMatchesFun (L (noAnnSrcSpanN loc) mono_id)
matches (mkCheckExpType $ idType mono_id)
- ; return ( FunBind { fun_id = L (noAnnSrcSpan loc) mono_id
+ ; return ( FunBind { fun_id = L (noAnnSrcSpanN loc) mono_id
, fun_matches = matches'
, fun_ext = (co_fn, [])
} ) }
diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs
index d42ee046b5..10830b9cd5 100644
--- a/compiler/GHC/Tc/Gen/Export.hs
+++ b/compiler/GHC/Tc/Gen/Export.hs
@@ -190,7 +190,7 @@ rnExports explicit_mod exports
| explicit_mod = exports
| has_main
= Just (noLocA [noLocA (IEVar noExtField
- (noLocA (IEName noExtField $ noLocA default_main)))])
+ (noLocA (IEName noExtField $ noLocN default_main)))])
-- ToDo: the 'noLoc' here is unhelpful if 'main'
-- turns out to be out of scope
| otherwise = Nothing
diff --git a/compiler/GHC/Tc/Gen/Expr.hs b/compiler/GHC/Tc/Gen/Expr.hs
index c2a680b3d4..aaf5a4ced7 100644
--- a/compiler/GHC/Tc/Gen/Expr.hs
+++ b/compiler/GHC/Tc/Gen/Expr.hs
@@ -255,7 +255,7 @@ tcExpr e@(HsIPVar _ x) res_ty
; ipClass <- tcLookupClass ipClassName
; ip_var <- emitWantedEvVar origin (mkClassPred ipClass [ip_name, ip_ty])
; tcWrapResult e
- (fromDict ipClass ip_name ip_ty (HsVar noExtField (noLocA ip_var)))
+ (fromDict ipClass ip_name ip_ty (HsVar noExtField (noLocN ip_var)))
ip_ty res_ty }
where
-- Coerces a dictionary for `IP "x" t` into `t`.
@@ -1520,7 +1520,7 @@ disambiguateRecordBinds record_expr record_rho rbnds res_ty
; return $ L l HsFieldBind
{ hfbAnn = hfbAnn upd
, hfbLHS
- = L (l2l loc) (Unambiguous i (L (l2l loc) lbl))
+ = L (l2l loc) (Unambiguous i (L (l2ln loc) lbl))
, hfbRHS = hfbRHS upd
, hfbPun = hfbPun upd
}
diff --git a/compiler/GHC/Tc/Gen/Foreign.hs b/compiler/GHC/Tc/Gen/Foreign.hs
index b8899e2431..570e580b59 100644
--- a/compiler/GHC/Tc/Gen/Foreign.hs
+++ b/compiler/GHC/Tc/Gen/Foreign.hs
@@ -402,7 +402,7 @@ tcFExport fo@(ForeignExport { fd_name = L loc nm, fd_sig_ty = hs_ty, fd_fe = spe
-- We need to give a name to the new top-level binding that
-- is *stable* (i.e. the compiler won't change it later),
-- because this name will be referred to by the C code stub.
- id <- mkStableIdFromName nm sig_ty (locA loc) mkForeignExportOcc
+ id <- mkStableIdFromName nm sig_ty (locN loc) mkForeignExportOcc
return ( mkVarBind id rhs
, ForeignExport { fd_name = L loc id
, fd_sig_ty = undefined
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs
index b01c7ccb5d..83e0e51b81 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -1007,11 +1007,11 @@ tcInferOverLit lit@(OverLit { ol_val = val
(1, []) from_ty
; co <- unifyType mb_thing (hsLitType hs_lit) (scaledThing sarg_ty)
- ; let lit_expr = L (l2l loc) $ mkHsWrapCo co $
+ ; let lit_expr = L (nn2la loc) $ mkHsWrapCo co $
HsLit noAnn hs_lit
from_expr = mkHsWrap (wrap2 <.> wrap1) $
HsVar noExtField (L loc from_id)
- witness = HsApp noAnn (L (l2l loc) from_expr) lit_expr
+ witness = HsApp noAnn (L (nn2la loc) from_expr) lit_expr
lit' = lit { ol_ext = OverLitTc { ol_rebindable = rebindable
, ol_witness = witness
, ol_type = res_ty } }
@@ -1030,7 +1030,7 @@ tcCheckId name res_ty
; addFunResCtxt rn_fun [] actual_res_ty res_ty $
tcWrapResultO (OccurrenceOf name) rn_fun expr actual_res_ty res_ty }
where
- rn_fun = HsVar noExtField (noLocA name)
+ rn_fun = HsVar noExtField (noLocN name)
------------------------
tcInferId :: Name -> TcM (HsExpr GhcTc, TcSigmaType)
@@ -1055,7 +1055,7 @@ tc_infer_assert assert_name
= do { assert_error_id <- tcLookupId assertErrorName
; (wrap, id_rho) <- topInstantiate (OccurrenceOf assert_name)
(idType assert_error_id)
- ; return (mkHsWrap wrap (HsVar noExtField (noLocA assert_error_id)), id_rho)
+ ; return (mkHsWrap wrap (HsVar noExtField (noLocN assert_error_id)), id_rho)
}
tc_infer_id :: Name -> TcM (HsExpr GhcTc, TcSigmaType)
@@ -1113,7 +1113,7 @@ tc_infer_id id_name
return $ unknownNameSuggestions WL_Anything dflags hpt curr_mod rdr_env
lcl_env imp_info (mkRdrUnqual occ)
- return_id id = return (HsVar noExtField (noLocA id), idType id)
+ return_id id = return (HsVar noExtField (noLocN id), idType id)
check_local_id :: Id -> TcM ()
check_local_id id
@@ -1324,7 +1324,7 @@ checkCrossStageLifting top_lvl id (Brack _ (TcPending ps_var lie_var q))
; lift <- if isStringTy id_ty then
do { sid <- tcLookupId GHC.Builtin.Names.TH.liftStringName
-- See Note [Lifting strings]
- ; return (HsVar noExtField (noLocA sid)) }
+ ; return (HsVar noExtField (noLocN sid)) }
else
setConstraintVar lie_var $
-- Put the 'lift' constraint into the right LIE
diff --git a/compiler/GHC/Tc/Gen/HsType.hs b/compiler/GHC/Tc/Gen/HsType.hs
index 19ea11f2d4..21c542c6c0 100644
--- a/compiler/GHC/Tc/Gen/HsType.hs
+++ b/compiler/GHC/Tc/Gen/HsType.hs
@@ -759,7 +759,7 @@ tcFamTyPats fam_tc hs_pats
where
fam_name = tyConName fam_tc
fam_arity = tyConArity fam_tc
- lhs_fun = noLocA (HsTyVar noAnn NotPromoted (noLocA fam_name))
+ lhs_fun = noLocA (HsTyVar noAnn NotPromoted (noLocN fam_name))
{- Note [tcFamTyPats: zonking the result kind]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1516,7 +1516,7 @@ splitHsAppTys hs_ty
go (L _ (HsAppKindTy l ty k)) as = go ty (HsTypeArg l k : as)
go (L sp (HsParTy _ f)) as = go f (HsArgPar (locA sp) : as)
go (L _ (HsOpTy _ prom l op@(L sp _) r)) as
- = ( L (na2la sp) (HsTyVar noAnn prom op)
+ = ( L (nn2la sp) (HsTyVar noAnn prom op)
, HsValArg l : HsValArg r : as )
go f as = (f, as)
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index c82a6ac1b5..01695e75ee 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -406,7 +406,7 @@ tc_pat pat_ty penv ps_pat thing_inside = case ps_pat of
AsPat x (L nm_loc name) at pat -> do
{ mult_wrap <- checkManyPattern pat_ty
-- See Note [Wrapper returned from tcSubMult] in GHC.Tc.Utils.Unify.
- ; (wrap, bndr_id) <- setSrcSpanA nm_loc (tcPatBndr penv name pat_ty)
+ ; (wrap, bndr_id) <- setSrcSpanN nm_loc (tcPatBndr penv name pat_ty)
; (pat', res) <- tcExtendIdEnv1 name bndr_id $
tc_lpat (pat_ty `scaledSet`(mkCheckExpType $ idType bndr_id))
penv pat thing_inside
@@ -653,7 +653,7 @@ AST is used for the subtraction operation.
<- tcSyntaxOpGen orig minus [SynType pat_exp_ty, SynRho] SynAny $
\ [lit2_ty, var_ty] _ ->
do { lit2' <- newOverloadedLit lit (mkCheckExpType lit2_ty)
- ; (wrap, bndr_id) <- setSrcSpanA nm_loc $
+ ; (wrap, bndr_id) <- setSrcSpanN nm_loc $
tcPatBndr penv name (unrestricted $ mkCheckExpType var_ty)
-- co :: var_ty ~ idType bndr_id
@@ -898,7 +898,7 @@ tcDataConPat penv (L con_span con_name) data_con pat_ty_scaled
; pat_ty <- readExpType (scaledThing pat_ty_scaled)
-- Add the stupid theta
- ; setSrcSpanA con_span $ addDataConStupidTheta data_con ctxt_res_tys
+ ; setSrcSpanN con_span $ addDataConStupidTheta data_con ctxt_res_tys
-- Check that this isn't a GADT pattern match
-- in situations in which that isn't allowed.
diff --git a/compiler/GHC/Tc/Gen/Rule.hs b/compiler/GHC/Tc/Gen/Rule.hs
index 38572d7341..8e8914a55f 100644
--- a/compiler/GHC/Tc/Gen/Rule.hs
+++ b/compiler/GHC/Tc/Gen/Rule.hs
@@ -182,7 +182,7 @@ tcRule (HsRule { rd_ext = ext
, rd_name = rname
, rd_act = act
, rd_tyvs = ty_bndrs -- preserved for ppr-ing
- , rd_tmvs = map (noLocA . RuleBndr noAnn . noLocA)
+ , rd_tmvs = map (noLocA . RuleBndr noAnn . noLocN)
(qtkvs ++ tpl_ids)
, rd_lhs = mkHsDictLet lhs_binds lhs'
, rd_rhs = mkHsDictLet rhs_binds rhs' } }
diff --git a/compiler/GHC/Tc/Gen/Splice.hs b/compiler/GHC/Tc/Gen/Splice.hs
index c856523f4f..f15a275617 100644
--- a/compiler/GHC/Tc/Gen/Splice.hs
+++ b/compiler/GHC/Tc/Gen/Splice.hs
@@ -1008,7 +1008,7 @@ runAnnotation target expr = do
; let loc' = noAnnSrcSpan loc
; let specialised_to_annotation_wrapper_expr
= L loc' (mkHsWrap wrapper
- (HsVar noExtField (L (noAnnSrcSpan loc) to_annotation_wrapper_id)))
+ (HsVar noExtField (L (noAnnSrcSpanN loc) to_annotation_wrapper_id)))
; return (L loc' (HsApp noComments
specialised_to_annotation_wrapper_expr expr'))
})
View Lorry Controller Status