summaryrefslogtreecommitdiff
path: root/compiler/rename
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/rename')
-rw-r--r--compiler/rename/RnEnv.hs9
-rw-r--r--compiler/rename/RnExpr.hs8
-rw-r--r--compiler/rename/RnPat.hs2
-rw-r--r--compiler/rename/RnSplice.hs16
-rw-r--r--compiler/rename/RnTypes.hs26
5 files changed, 32 insertions, 29 deletions
diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs
index 801bc2724f..f8969a8e13 100644
--- a/compiler/rename/RnEnv.hs
+++ b/compiler/rename/RnEnv.hs
@@ -75,7 +75,8 @@ import DataCon
import TyCon
import PrelNames ( mkUnboundName, isUnboundName, rOOT_MAIN, forall_tv_RDR )
import ErrUtils ( MsgDoc )
-import BasicTypes ( Fixity(..), FixityDirection(..), minPrecedence, defaultFixity )
+import BasicTypes ( Fixity(..), FixityDirection(..), minPrecedence,
+ defaultFixity, pprWarningTxtForMsg, SourceText(..) )
import SrcLoc
import Outputable
import Util
@@ -1072,7 +1073,7 @@ warnIfDeprecated gre@(GRE { gre_name = name, gre_imp = iss })
<+> pprNonVarNameSpace (occNameSpace occ)
<+> quotes (ppr occ)
, parens imp_msg <> colon ]
- , ppr txt ]
+ , pprWarningTxtForMsg txt ]
where
imp_mod = importSpecModule imp_spec
imp_msg = text "imported from" <+> ppr imp_mod <> extra
@@ -1438,7 +1439,7 @@ lookupFixityRn_help' :: Name
-> RnM (Bool, Fixity)
lookupFixityRn_help' name occ
| isUnboundName name
- = return (False, Fixity (show minPrecedence) minPrecedence InfixL)
+ = return (False, Fixity NoSourceText minPrecedence InfixL)
-- Minimise errors from ubound names; eg
-- a>0 `foo` b>0
-- where 'foo' is not in scope, should not give an error (Trac #7937)
@@ -1517,7 +1518,7 @@ lookupFieldFixityRn (Ambiguous (L _ rdr) _) = get_ambiguous_fixity rdr
[] -> panic "get_ambiguous_fixity: no candidates for a given RdrName"
[ (_, fix):_ ] -> return fix
ambigs -> addErr (ambiguous_fixity_err rdr_name ambigs)
- >> return (Fixity(show minPrecedence) minPrecedence InfixL)
+ >> return (Fixity NoSourceText minPrecedence InfixL)
lookup_gre_fixity gre = lookupFixityRn' (gre_name gre) (greOccName gre)
diff --git a/compiler/rename/RnExpr.hs b/compiler/rename/RnExpr.hs
index 991162dec8..7cafc2b22f 100644
--- a/compiler/rename/RnExpr.hs
+++ b/compiler/rename/RnExpr.hs
@@ -168,7 +168,7 @@ rnExpr (OpApp e1 op _ e2)
; fixity <- case op' of
L _ (HsVar (L _ n)) -> lookupFixityRn n
L _ (HsRecFld f) -> lookupFieldFixityRn f
- _ -> return (Fixity (show minPrecedence) minPrecedence InfixL)
+ _ -> return (Fixity NoSourceText minPrecedence InfixL)
-- c.f. lookupFixity for unbound
; final_e <- mkOpAppRn e1' op' fixity e2'
@@ -474,7 +474,7 @@ rnCmd (HsCmdArrApp arrow arg _ ho rtl)
-- inside 'arrow'. In the higher-order case (-<<), they are.
-- infix form
-rnCmd (HsCmdArrForm op (Just _) [arg1, arg2])
+rnCmd (HsCmdArrForm op _ (Just _) [arg1, arg2])
= do { (op',fv_op) <- escapeArrowScope (rnLExpr op)
; let L _ (HsVar (L _ op_name)) = op'
; (arg1',fv_arg1) <- rnCmdTop arg1
@@ -484,10 +484,10 @@ rnCmd (HsCmdArrForm op (Just _) [arg1, arg2])
; final_e <- mkOpFormRn arg1' op' fixity arg2'
; return (final_e, fv_arg1 `plusFV` fv_op `plusFV` fv_arg2) }
-rnCmd (HsCmdArrForm op fixity cmds)
+rnCmd (HsCmdArrForm op f fixity cmds)
= do { (op',fvOp) <- escapeArrowScope (rnLExpr op)
; (cmds',fvCmds) <- rnCmdArgs cmds
- ; return (HsCmdArrForm op' fixity cmds', fvOp `plusFV` fvCmds) }
+ ; return (HsCmdArrForm op' f fixity cmds', fvOp `plusFV` fvCmds) }
rnCmd (HsCmdApp fun arg)
= do { (fun',fvFun) <- rnLCmd fun
diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs
index e67be63fa4..2122c70c97 100644
--- a/compiler/rename/RnPat.hs
+++ b/compiler/rename/RnPat.hs
@@ -817,7 +817,7 @@ rnLit _ = return ()
-- Integer-looking literal.
generalizeOverLitVal :: OverLitVal -> OverLitVal
generalizeOverLitVal (HsFractional (FL {fl_text=src,fl_value=val}))
- | denominator val == 1 = HsIntegral src (numerator val)
+ | denominator val == 1 = HsIntegral (SourceText src) (numerator val)
generalizeOverLitVal lit = lit
rnOverLit :: HsOverLit t -> RnM (HsOverLit Name, FreeVars)
diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs
index 57c35873a8..0c41ed30b6 100644
--- a/compiler/rename/RnSplice.hs
+++ b/compiler/rename/RnSplice.hs
@@ -22,7 +22,7 @@ import Kind
import RnEnv
import RnSource ( rnSrcDecls, findSplice )
import RnPat ( rnPat )
-import BasicTypes ( TopLevelFlag, isTopLevel )
+import BasicTypes ( TopLevelFlag, isTopLevel, SourceText(..) )
import Outputable
import Module
import SrcLoc
@@ -309,7 +309,7 @@ runRnSplice flavour run_meta ppr_res splice
= do { splice' <- getHooked runRnSpliceHook return >>= ($ splice)
; let the_expr = case splice' of
- HsUntypedSplice _ e -> e
+ HsUntypedSplice _ _ e -> e
HsQuasiQuote _ q qs str -> mkQuasiQuoteExpr flavour q qs str
HsTypedSplice {} -> pprPanic "runRnSplice" (ppr splice)
HsSpliced {} -> pprPanic "runRnSplice" (ppr splice)
@@ -350,7 +350,7 @@ runRnSplice flavour run_meta ppr_res splice
makePending :: UntypedSpliceFlavour
-> HsSplice Name
-> PendingRnSplice
-makePending flavour (HsUntypedSplice n e)
+makePending flavour (HsUntypedSplice _ n e)
= PendingRnSplice flavour n e
makePending flavour (HsQuasiQuote n quoter q_span quote)
= PendingRnSplice flavour n (mkQuasiQuoteExpr flavour quoter q_span quote)
@@ -370,7 +370,7 @@ mkQuasiQuoteExpr flavour quoter q_span quote
quoteExpr
where
quoterExpr = L q_span $! HsVar $! (L q_span quoter)
- quoteExpr = L q_span $! HsLit $! HsString "" quote
+ quoteExpr = L q_span $! HsLit $! HsString NoSourceText quote
quote_selector = case flavour of
UntypedExpSplice -> quoteExpName
UntypedPatSplice -> quotePatName
@@ -380,19 +380,19 @@ mkQuasiQuoteExpr flavour quoter q_span quote
---------------------
rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
-- Not exported...used for all
-rnSplice (HsTypedSplice splice_name expr)
+rnSplice (HsTypedSplice hasParen splice_name expr)
= do { checkTH expr "Template Haskell typed splice"
; loc <- getSrcSpanM
; n' <- newLocalBndrRn (L loc splice_name)
; (expr', fvs) <- rnLExpr expr
- ; return (HsTypedSplice n' expr', fvs) }
+ ; return (HsTypedSplice hasParen n' expr', fvs) }
-rnSplice (HsUntypedSplice splice_name expr)
+rnSplice (HsUntypedSplice hasParen splice_name expr)
= do { checkTH expr "Template Haskell untyped splice"
; loc <- getSrcSpanM
; n' <- newLocalBndrRn (L loc splice_name)
; (expr', fvs) <- rnLExpr expr
- ; return (HsUntypedSplice n' expr', fvs) }
+ ; return (HsUntypedSplice hasParen n' expr', fvs) }
rnSplice (HsQuasiQuote splice_name quoter q_loc quote)
= do { checkTH quoter "Template Haskell quasi-quote"
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index c548c4d0a6..00e27152de 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -464,9 +464,9 @@ rnHsTyKi env ty@(HsQualTy { hst_ctxt = lctxt, hst_body = tau })
; return (HsQualTy { hst_ctxt = ctxt', hst_body = tau' }
, fvs1 `plusFV` fvs2) }
-rnHsTyKi env (HsTyVar (L loc rdr_name))
+rnHsTyKi env (HsTyVar ip (L loc rdr_name))
= do { name <- rnTyVar env rdr_name
- ; return (HsTyVar (L loc name), unitFV name) }
+ ; return (HsTyVar ip (L loc name), unitFV name) }
rnHsTyKi env ty@(HsOpTy ty1 l_op ty2)
= setSrcSpan (getLoc l_op) $
@@ -586,7 +586,8 @@ rnHsTyKi env overall_ty@(HsAppsTy tys)
(non_syms1 : non_syms2 : non_syms) (L loc star : ops)
| star `hasKey` starKindTyConKey || star `hasKey` unicodeStarKindTyConKey
= deal_with_star acc1 acc2
- ((non_syms1 ++ L loc (HsTyVar (L loc star)) : non_syms2) : non_syms)
+ ((non_syms1 ++ L loc (HsTyVar NotPromoted (L loc star))
+ : non_syms2) : non_syms)
ops
deal_with_star acc1 acc2 (non_syms1 : non_syms) (op1 : ops)
= deal_with_star (non_syms1 : acc1) (op1 : acc2) non_syms ops
@@ -643,12 +644,12 @@ rnHsTyKi _ (HsCoreTy ty)
-- The emptyFVs probably isn't quite right
-- but I don't think it matters
-rnHsTyKi env ty@(HsExplicitListTy k tys)
+rnHsTyKi env ty@(HsExplicitListTy ip k tys)
= do { checkTypeInType env ty
; data_kinds <- xoptM LangExt.DataKinds
; unless data_kinds (addErr (dataKindsErr env ty))
; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
- ; return (HsExplicitListTy k tys', fvs) }
+ ; return (HsExplicitListTy ip k tys', fvs) }
rnHsTyKi env ty@(HsExplicitTupleTy kis tys)
= do { checkTypeInType env ty
@@ -1034,7 +1035,7 @@ collectAnonWildCards lty = go lty
HsDocTy ty _ -> go ty
HsBangTy _ ty -> go ty
HsRecTy flds -> gos $ map (cd_fld_type . unLoc) flds
- HsExplicitListTy _ tys -> gos tys
+ HsExplicitListTy _ _ tys -> gos tys
HsExplicitTupleTy _ tys -> gos tys
HsForAllTy { hst_bndrs = bndrs
, hst_body = ty } -> collectAnonWildCardsBndrs bndrs
@@ -1247,15 +1248,16 @@ mkOpFormRn :: LHsCmdTop Name -- Left operand; already rearranged
-> RnM (HsCmd Name)
-- (e11 `op1` e12) `op2` e2
-mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsCmdArrForm op1 (Just fix1) [a11,a12])) _ _ _))
+mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsCmdArrForm op1 f (Just fix1)
+ [a11,a12])) _ _ _))
op2 fix2 a2
| nofix_error
= do precParseErr (get_op op1,fix1) (get_op op2,fix2)
- return (HsCmdArrForm op2 (Just fix2) [a1, a2])
+ return (HsCmdArrForm op2 f (Just fix2) [a1, a2])
| associate_right
= do new_c <- mkOpFormRn a12 op2 fix2 a2
- return (HsCmdArrForm op1 (Just fix1)
+ return (HsCmdArrForm op1 f (Just fix1)
[a11, L loc (HsCmdTop (L loc new_c)
placeHolderType placeHolderType [])])
-- TODO: locs are wrong
@@ -1264,7 +1266,7 @@ mkOpFormRn a1@(L loc (HsCmdTop (L _ (HsCmdArrForm op1 (Just fix1) [a11,a12])) _
-- Default case
mkOpFormRn arg1 op fix arg2 -- Default case, no rearrangment
- = return (HsCmdArrForm op (Just fix) [arg1, arg2])
+ = return (HsCmdArrForm op Infix (Just fix) [arg1, arg2])
--------------------------------------
@@ -1600,7 +1602,7 @@ extract_lkind = extract_lty KindLevel
extract_lty :: TypeOrKind -> LHsType RdrName -> FreeKiTyVars -> RnM FreeKiTyVars
extract_lty t_or_k (L _ ty) acc
= case ty of
- HsTyVar ltv -> extract_tv t_or_k ltv acc
+ HsTyVar _ ltv -> extract_tv t_or_k ltv acc
HsBangTy _ ty -> extract_lty t_or_k ty acc
HsRecTy flds -> foldrM (extract_lty t_or_k
. cd_fld_type . unLoc) acc
@@ -1624,7 +1626,7 @@ extract_lty t_or_k (L _ ty) acc
HsCoreTy {} -> return acc -- The type is closed
HsSpliceTy {} -> return acc -- Type splices mention no tvs
HsDocTy ty _ -> extract_lty t_or_k ty acc
- HsExplicitListTy _ tys -> extract_ltys t_or_k tys acc
+ HsExplicitListTy _ _ tys -> extract_ltys t_or_k tys acc
HsExplicitTupleTy _ tys -> extract_ltys t_or_k tys acc
HsTyLit _ -> return acc
HsKindSig ty ki -> extract_lty t_or_k ty =<<
View Lorry Controller Status