[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 3 commits: AArch64: Simplify BL instruction
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Jun 19 07:36:13 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
04a5170f by Sven Tennie at 2024-06-19T03:35:51-04:00
AArch64: Simplify BL instruction
The BL constructor carried unused data in its third argument.
- - - - -
cae6052d by Alan Zimmerman at 2024-06-19T03:35:52-04:00
TTG: Move SourceText from `Fixity` to `FixitySig`
It is only used there, simplifies the use of `Fixity` in the rest of
the code, and is moved into a TTG extension point.
Precedes !12842, to simplify it
- - - - -
72bacf3f by Rodrigo Mesquita at 2024-06-19T03:35:53-04:00
base: Deprecate some .Internal modules
Deprecates the following modules according to clc-proposal #217:
https://github.com/haskell/core-libraries-committee/issues/217
* GHC.TypeNats.Internal
* GHC.TypeLits.Internal
* GHC.ExecutionStack.Internal
Closes #24998
- - - - -
30 changed files:
- compiler/GHC/Builtin/PrimOps.hs
- compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
- compiler/GHC/CmmToAsm/AArch64/Instr.hs
- compiler/GHC/CmmToAsm/AArch64/Ppr.hs
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Dump.hs
- compiler/GHC/HsToCore/Quote.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Rename/Expr.hs
- compiler/GHC/Rename/Fixity.hs
- compiler/GHC/Rename/HsType.hs
- compiler/GHC/Tc/Deriv/Generate.hs
- compiler/GHC/Tc/Deriv/Generics.hs
- compiler/GHC/Tc/Gen/Splice.hs
- compiler/GHC/ThToHs.hs
- compiler/GHC/Types/Fixity.hs
- libraries/base/src/GHC/ExecutionStack/Internal.hs
- libraries/base/src/GHC/TypeLits/Internal.hs
- libraries/base/src/GHC/TypeNats/Internal.hs
- testsuite/tests/parser/should_compile/T20846.stderr
- utils/check-exact/ExactPrint.hs
- utils/genprimopcode/Main.hs
- utils/genprimopcode/Parser.y
- utils/genprimopcode/Syntax.hs
- utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Json.hs
- utils/haddock/haddock-api/src/Haddock/Types.hs
Changes:
=====================================
compiler/GHC/Builtin/PrimOps.hs
=====================================
@@ -49,7 +49,6 @@ import GHC.Types.Basic
import GHC.Types.Fixity ( Fixity(..), FixityDirection(..) )
import GHC.Types.SrcLoc ( wiredInSrcSpan )
import GHC.Types.ForeignCall ( CLabelString )
-import GHC.Types.SourceText ( SourceText(..) )
import GHC.Types.Unique ( Unique )
import GHC.Unit.Types ( Unit )
=====================================
compiler/GHC/CmmToAsm/AArch64/CodeGen.hs
=====================================
@@ -1596,7 +1596,7 @@ genCCall target dest_regs arg_regs bid = do
then 8 * (stackSpace' `div` 8 + 1)
else stackSpace'
- (returnRegs, readResultsCode) <- readResults allGpArgRegs allFpArgRegs dest_regs [] nilOL
+ readResultsCode <- readResults allGpArgRegs allFpArgRegs dest_regs [] nilOL
let moveStackDown 0 = toOL [ PUSH_STACK_FRAME
, DELTA (-16) ]
@@ -1614,7 +1614,7 @@ genCCall target dest_regs arg_regs bid = do
let code = call_target_code -- compute the label (possibly into a register)
`appOL` moveStackDown (stackSpace `div` 8)
`appOL` passArgumentsCode -- put the arguments into x0, ...
- `appOL` (unitOL $ BL call_target passRegs returnRegs) -- branch and link.
+ `appOL` (unitOL $ BL call_target passRegs) -- branch and link.
`appOL` readResultsCode -- parse the results into registers
`appOL` moveStackUp (stackSpace `div` 8)
return (code, Nothing)
@@ -2203,8 +2203,8 @@ genCCall target dest_regs arg_regs bid = do
passArguments _ _ _ _ _ _ _ = pprPanic "passArguments" (text "invalid state")
- readResults :: [Reg] -> [Reg] -> [LocalReg] -> [Reg]-> InstrBlock -> NatM ([Reg], InstrBlock)
- readResults _ _ [] accumRegs accumCode = return (accumRegs, accumCode)
+ readResults :: [Reg] -> [Reg] -> [LocalReg] -> [Reg]-> InstrBlock -> NatM (InstrBlock)
+ readResults _ _ [] _ accumCode = return accumCode
readResults [] _ _ _ _ = do
platform <- getPlatform
pprPanic "genCCall, out of gp registers when reading results" (pdoc platform target)
=====================================
compiler/GHC/CmmToAsm/AArch64/Instr.hs
=====================================
@@ -117,7 +117,7 @@ regUsageOfInstr platform instr = case instr of
J t -> usage (regTarget t, [])
B t -> usage (regTarget t, [])
BCOND _ t -> usage (regTarget t, [])
- BL t ps _rs -> usage (regTarget t ++ ps, callerSavedRegisters)
+ BL t ps -> usage (regTarget t ++ ps, callerSavedRegisters)
-- 5. Atomic Instructions ----------------------------------------------------
-- 6. Conditional Instructions -----------------------------------------------
@@ -254,7 +254,7 @@ patchRegsOfInstr instr env = case instr of
-- 4. Branch Instructions --------------------------------------------------
J t -> J (patchTarget t)
B t -> B (patchTarget t)
- BL t rs ts -> BL (patchTarget t) rs ts
+ BL t rs -> BL (patchTarget t) rs
BCOND c t -> BCOND c (patchTarget t)
-- 5. Atomic Instructions --------------------------------------------------
@@ -320,7 +320,7 @@ jumpDestsOfInstr (CBZ _ t) = [ id | TBlock id <- [t]]
jumpDestsOfInstr (CBNZ _ t) = [ id | TBlock id <- [t]]
jumpDestsOfInstr (J t) = [id | TBlock id <- [t]]
jumpDestsOfInstr (B t) = [id | TBlock id <- [t]]
-jumpDestsOfInstr (BL t _ _) = [ id | TBlock id <- [t]]
+jumpDestsOfInstr (BL t _) = [ id | TBlock id <- [t]]
jumpDestsOfInstr (BCOND _ t) = [ id | TBlock id <- [t]]
jumpDestsOfInstr _ = []
@@ -341,7 +341,7 @@ patchJumpInstr instr patchF
CBNZ r (TBlock bid) -> CBNZ r (TBlock (patchF bid))
J (TBlock bid) -> J (TBlock (patchF bid))
B (TBlock bid) -> B (TBlock (patchF bid))
- BL (TBlock bid) ps rs -> BL (TBlock (patchF bid)) ps rs
+ BL (TBlock bid) ps -> BL (TBlock (patchF bid)) ps
BCOND c (TBlock bid) -> BCOND c (TBlock (patchF bid))
_ -> panic $ "patchJumpInstr: " ++ instrCon instr
@@ -626,7 +626,7 @@ data Instr
-- Branching.
| J Target -- like B, but only generated from genJump. Used to distinguish genJumps from others.
| B Target -- unconditional branching b/br. (To a blockid, label or register)
- | BL Target [Reg] [Reg] -- branch and link (e.g. set x30 to next pc, and branch)
+ | BL Target [Reg] -- branch and link (e.g. set x30 to next pc, and branch)
| BCOND Cond Target -- branch with condition. b.<cond>
-- 8. Synchronization Instructions -----------------------------------------
=====================================
compiler/GHC/CmmToAsm/AArch64/Ppr.hs
=====================================
@@ -426,9 +426,9 @@ pprInstr platform instr = case instr of
B (TLabel lbl) -> line $ text "\tb" <+> pprAsmLabel platform lbl
B (TReg r) -> line $ text "\tbr" <+> pprReg W64 r
- BL (TBlock bid) _ _ -> line $ text "\tbl" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
- BL (TLabel lbl) _ _ -> line $ text "\tbl" <+> pprAsmLabel platform lbl
- BL (TReg r) _ _ -> line $ text "\tblr" <+> pprReg W64 r
+ BL (TBlock bid) _ -> line $ text "\tbl" <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
+ BL (TLabel lbl) _ -> line $ text "\tbl" <+> pprAsmLabel platform lbl
+ BL (TReg r) _ -> line $ text "\tblr" <+> pprReg W64 r
BCOND c (TBlock bid) -> line $ text "\t" <> pprBcond c <+> pprAsmLabel platform (mkLocalBlockLabel (getUnique bid))
BCOND c (TLabel lbl) -> line $ text "\t" <> pprBcond c <+> pprAsmLabel platform lbl
=====================================
compiler/GHC/Hs/Binds.hs
=====================================
@@ -708,7 +708,7 @@ instance OutputableBndrId p => Outputable (IPBind (GhcPass p)) where
type instance XTypeSig (GhcPass p) = AnnSig
type instance XPatSynSig (GhcPass p) = AnnSig
type instance XClassOpSig (GhcPass p) = AnnSig
-type instance XFixSig (GhcPass p) = [AddEpAnn]
+type instance XFixSig (GhcPass p) = ([AddEpAnn], SourceText)
type instance XInlineSig (GhcPass p) = [AddEpAnn]
type instance XSpecSig (GhcPass p) = [AddEpAnn]
type instance XSpecInstSig (GhcPass p) = ([AddEpAnn], SourceText)
=====================================
compiler/GHC/Hs/Dump.hs
=====================================
@@ -74,7 +74,6 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
`extQ` name `extQ` occName `extQ` moduleName `extQ` var
`extQ` dataCon
`extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet
- `extQ` fixity
`ext2Q` located
`extQ` srcSpanAnnA
`extQ` srcSpanAnnL
@@ -139,11 +138,12 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
, generic s ]
sourceText :: SourceText -> SDoc
- sourceText NoSourceText = parens $ text "NoSourceText"
+ sourceText NoSourceText = case bs of
+ BlankSrcSpan -> parens $ text "SourceText" <+> text "blanked"
+ _ -> parens $ text "NoSourceText"
sourceText (SourceText src) = case bs of
- NoBlankSrcSpan -> parens $ text "SourceText" <+> ftext src
- BlankSrcSpanFile -> parens $ text "SourceText" <+> ftext src
- _ -> parens $ text "SourceText" <+> text "blanked"
+ BlankSrcSpan -> parens $ text "SourceText" <+> text "blanked"
+ _ -> parens $ text "SourceText" <+> ftext src
epaAnchor :: EpaLocation -> SDoc
epaAnchor (EpaSpan s) = parens $ text "EpaSpan" <+> srcSpan s
@@ -216,11 +216,6 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
text "NameSet:"
$$ (list . nameSetElemsStable $ ns)
- fixity :: Fixity -> SDoc
- fixity fx = braces $
- text "Fixity:"
- <+> ppr fx
-
located :: (Data a, Data b) => GenLocated a b -> SDoc
located (L ss a)
= parens (text "L"
=====================================
compiler/GHC/HsToCore/Quote.hs
=====================================
@@ -780,7 +780,7 @@ repLFixD :: LFixitySig GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
repLFixD (L loc fix_sig) = rep_fix_d (locA loc) fix_sig
rep_fix_d :: SrcSpan -> FixitySig GhcRn -> MetaM [(SrcSpan, Core (M TH.Dec))]
-rep_fix_d loc (FixitySig ns_spec names (Fixity _ prec dir))
+rep_fix_d loc (FixitySig ns_spec names (Fixity prec dir))
= do { MkC prec' <- coreIntLit prec
; let rep_fn = case dir of
InfixL -> infixLWithSpecDName
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -90,7 +90,6 @@ import GHC.Types.Avail
import GHC.Types.Fixity
import GHC.Types.Fixity.Env
import GHC.Types.SourceError
-import GHC.Types.SourceText
import GHC.Types.SourceFile
import GHC.Types.SafeHaskell
import GHC.Types.TypeEnv
@@ -1029,7 +1028,7 @@ ghcPrimIface
-- The fixity listed here for @`seq`@ should match
-- those in primops.txt.pp (from which Haddock docs are generated).
- fixities = (getOccName seqId, Fixity NoSourceText 0 InfixR)
+ fixities = (getOccName seqId, Fixity 0 InfixR)
: mapMaybe mkFixity allThePrimOps
mkFixity op = (,) (primOpOcc op) <$> primOpFixity op
@@ -1235,5 +1234,3 @@ instance Outputable WhereFrom where
ppr (ImportByUser NotBoot) = empty
ppr ImportBySystem = text "{- SYSTEM -}"
ppr ImportByPlugin = text "{- PLUGIN -}"
-
-
=====================================
compiler/GHC/Parser.y
=====================================
@@ -2679,8 +2679,8 @@ sigdecl :: { LHsDecl GhcPs }
Nothing -> (NoSourceText, maxPrecedence)
Just l2 -> (fst $ unLoc l2, snd $ unLoc l2)
; amsA' (sLL $1 $> $ SigD noExtField
- (FixSig (mj AnnInfix $1 : maybeToList mbPrecAnn) (FixitySig (unLoc $3) (fromOL $ unLoc $4)
- (Fixity fixText fixPrec (unLoc $1)))))
+ (FixSig (mj AnnInfix $1 : maybeToList mbPrecAnn, fixText) (FixitySig (unLoc $3) (fromOL $ unLoc $4)
+ (Fixity fixPrec (unLoc $1)))))
}}
| pattern_synonym_sig { L (getLoc $1) . SigD noExtField . unLoc $ $1 }
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -112,6 +112,7 @@ import GHC.Hs.DocString
import GHC.Utils.Outputable hiding ( (<>) )
import GHC.Utils.Panic
import qualified GHC.Data.Strict as Strict
+import GHC.Types.SourceText (SourceText (NoSourceText))
{-
Note [exact print annotations]
@@ -1363,6 +1364,9 @@ instance NoAnn (EpToken s) where
instance NoAnn (EpUniToken s t) where
noAnn = NoEpUniTok
+instance NoAnn SourceText where
+ noAnn = NoSourceText
+
-- ---------------------------------------------------------------------
instance (Outputable a) => Outputable (EpAnn a) where
=====================================
compiler/GHC/Rename/Expr.hs
=====================================
@@ -411,7 +411,7 @@ rnExpr (OpApp _ e1 op e2)
; fixity <- case op' of
L _ (HsVar _ (L _ n)) -> lookupFixityRn n
L _ (HsRecSel _ f) -> lookupFieldFixityRn f
- _ -> return (Fixity NoSourceText minPrecedence InfixL)
+ _ -> return (Fixity minPrecedence InfixL)
-- c.f. lookupFixity for unbound
; lexical_negation <- xoptM LangExt.LexicalNegation
=====================================
compiler/GHC/Rename/Fixity.hs
=====================================
@@ -27,7 +27,6 @@ import GHC.Types.Fixity.Env
import GHC.Types.Name
import GHC.Types.Name.Env
import GHC.Types.Fixity
-import GHC.Types.SourceText
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
@@ -147,7 +146,7 @@ lookupFixityRn_help :: Name
-> RnM (Bool, Fixity)
lookupFixityRn_help name
| isUnboundName name
- = return (False, Fixity NoSourceText minPrecedence InfixL)
+ = return (False, Fixity minPrecedence InfixL)
-- Minimise errors from unbound names; eg
-- a>0 `foo` b>0
-- where 'foo' is not in scope, should not give an error (#7937)
=====================================
compiler/GHC/Rename/HsType.hs
=====================================
@@ -1557,8 +1557,8 @@ checkPrecMatch op (MG { mg_alts = (L _ ms) })
checkPrec :: Name -> Pat GhcRn -> Bool -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkPrec op (ConPat NoExtField op1 (InfixCon _ _)) right = do
- op_fix@(Fixity _ op_prec op_dir) <- lookupFixityRn op
- op1_fix@(Fixity _ op1_prec op1_dir) <- lookupFixityRn (unLoc op1)
+ op_fix@(Fixity op_prec op_dir) <- lookupFixityRn op
+ op1_fix@(Fixity op1_prec op1_dir) <- lookupFixityRn (unLoc op1)
let
inf_ok = op1_prec > op_prec ||
(op1_prec == op_prec &&
@@ -1586,8 +1586,8 @@ checkSectionPrec direction section op arg
_ -> return ()
where
op_name = get_op op
- go_for_it arg_op arg_fix@(Fixity _ arg_prec assoc) = do
- op_fix@(Fixity _ op_prec _) <- lookupFixityOp op_name
+ go_for_it arg_op arg_fix@(Fixity arg_prec assoc) = do
+ op_fix@(Fixity op_prec _) <- lookupFixityOp op_name
unless (op_prec < arg_prec
|| (op_prec == arg_prec && direction == assoc))
(sectionPrecErr (get_op op, op_fix)
=====================================
compiler/GHC/Tc/Deriv/Generate.hs
=====================================
@@ -1336,7 +1336,7 @@ appPrecedence = fromIntegral maxPrecedence + 1
getPrecedence :: (Name -> Fixity) -> Name -> Integer
getPrecedence get_fixity nm
= case get_fixity nm of
- Fixity _ x _assoc -> fromIntegral x
+ Fixity x _assoc -> fromIntegral x
-- NB: the Report says that associativity is not taken
-- into account for either Read or Show; hence we
-- ignore associativity here
=====================================
compiler/GHC/Tc/Deriv/Generics.hs
=====================================
@@ -654,9 +654,9 @@ tc_mkRepTy gk get_fixity dit@(DerivInstTys{ dit_rep_tc = tycon
ctFix c
| dataConIsInfix c
= case get_fixity (dataConName c) of
- Fixity _ n InfixL -> buildFix n pLA
- Fixity _ n InfixR -> buildFix n pRA
- Fixity _ n InfixN -> buildFix n pNA
+ Fixity n InfixL -> buildFix n pLA
+ Fixity n InfixR -> buildFix n pRA
+ Fixity n InfixN -> buildFix n pNA
| otherwise = mkTyConTy pPrefix
buildFix n assoc = mkTyConApp pInfix [ mkTyConTy assoc
, mkNumLitTy (fromIntegral n)]
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -2816,7 +2816,7 @@ reifyFixity name
= do { (found, fix) <- lookupFixityRn_help name
; return (if found then Just (conv_fix fix) else Nothing) }
where
- conv_fix (Hs.Fixity _ i d) = TH.Fixity i (conv_dir d)
+ conv_fix (Hs.Fixity i d) = TH.Fixity i (conv_dir d)
conv_dir Hs.InfixR = TH.InfixR
conv_dir Hs.InfixL = TH.InfixL
conv_dir Hs.InfixN = TH.InfixN
=====================================
compiler/GHC/ThToHs.hs
=====================================
@@ -1984,7 +1984,7 @@ cvtPatSynSigTy ty = cvtSigType ty
-----------------------------------------------------------
cvtFixity :: TH.Fixity -> Hs.Fixity
-cvtFixity (TH.Fixity prec dir) = Hs.Fixity NoSourceText prec (cvt_dir dir)
+cvtFixity (TH.Fixity prec dir) = Hs.Fixity prec (cvt_dir dir)
where
cvt_dir TH.InfixL = Hs.InfixL
cvt_dir TH.InfixR = Hs.InfixR
=====================================
compiler/GHC/Types/Fixity.hs
=====================================
@@ -16,33 +16,28 @@ where
import GHC.Prelude
-import GHC.Types.SourceText
-
import GHC.Utils.Outputable
import GHC.Utils.Binary
import Data.Data hiding (Fixity, Prefix, Infix)
-data Fixity = Fixity SourceText Int FixityDirection
- -- Note [Pragma source text] in "GHC.Types.SourceText"
+data Fixity = Fixity Int FixityDirection
deriving Data
instance Outputable Fixity where
- ppr (Fixity _ prec dir) = hcat [ppr dir, space, int prec]
+ ppr (Fixity prec dir) = hcat [ppr dir, space, int prec]
instance Eq Fixity where -- Used to determine if two fixities conflict
- (Fixity _ p1 dir1) == (Fixity _ p2 dir2) = p1==p2 && dir1 == dir2
+ (Fixity p1 dir1) == (Fixity p2 dir2) = p1==p2 && dir1 == dir2
instance Binary Fixity where
- put_ bh (Fixity src aa ab) = do
- put_ bh src
+ put_ bh (Fixity aa ab) = do
put_ bh aa
put_ bh ab
get bh = do
- src <- get bh
aa <- get bh
ab <- get bh
- return (Fixity src aa ab)
+ return (Fixity aa ab)
------------------------
data FixityDirection
@@ -76,12 +71,12 @@ maxPrecedence = 9
minPrecedence = 0
defaultFixity :: Fixity
-defaultFixity = Fixity NoSourceText maxPrecedence InfixL
+defaultFixity = Fixity maxPrecedence InfixL
negateFixity, funTyFixity :: Fixity
-- Wired-in fixities
-negateFixity = Fixity NoSourceText 6 InfixL -- Fixity of unary negate
-funTyFixity = Fixity NoSourceText (-1) InfixR -- Fixity of '->', see #15235
+negateFixity = Fixity 6 InfixL -- Fixity of unary negate
+funTyFixity = Fixity (-1) InfixR -- Fixity of '->', see #15235
{-
Consider
@@ -96,7 +91,7 @@ whether there's an error.
compareFixity :: Fixity -> Fixity
-> (Bool, -- Error please
Bool) -- Associate to the right: a op1 (b op2 c)
-compareFixity (Fixity _ prec1 dir1) (Fixity _ prec2 dir2)
+compareFixity (Fixity prec1 dir1) (Fixity prec2 dir2)
= case prec1 `compare` prec2 of
GT -> left
LT -> right
=====================================
libraries/base/src/GHC/ExecutionStack/Internal.hs
=====================================
@@ -16,7 +16,7 @@
--
-- @since 4.9.0.0
-module GHC.ExecutionStack.Internal (
+module GHC.ExecutionStack.Internal {-# DEPRECATED "This module will be removed from base in the next version (v4.22)" #-} (
-- * Internal
Location (..)
, SrcLoc (..)
=====================================
libraries/base/src/GHC/TypeLits/Internal.hs
=====================================
@@ -26,7 +26,7 @@
--
-- @since 4.16.0.0
-module GHC.TypeLits.Internal
+module GHC.TypeLits.Internal {-# DEPRECATED "This module will be removed from base in the next version (v4.22)" #-}
(Symbol,
CmpSymbol,
CmpChar
=====================================
libraries/base/src/GHC/TypeNats/Internal.hs
=====================================
@@ -1,7 +1,7 @@
{-# LANGUAGE Safe #-}
{-# OPTIONS_HADDOCK not-home #-}
-module GHC.TypeNats.Internal
+module GHC.TypeNats.Internal {-# DEPRECATED "This module will be removed from base in the next version (v4.22)" #-}
(Natural,
CmpNat
) where
=====================================
testsuite/tests/parser/should_compile/T20846.stderr
=====================================
@@ -44,7 +44,9 @@
(SigD
(NoExtField)
(FixSig
- [(AddEpAnn AnnInfix (EpaSpan { T20846.hs:3:1-6 }))]
+ ((,)
+ [(AddEpAnn AnnInfix (EpaSpan { T20846.hs:3:1-6 }))]
+ (NoSourceText))
(FixitySig
(NoNamespaceSpecifier)
[(L
@@ -56,7 +58,9 @@
[]))
(Unqual
{OccName: ++++}))]
- {Fixity: infixr 9}))))
+ (Fixity
+ (9)
+ (InfixR))))))
,(L
(EpAnn
(EpaSpan { T20846.hs:4:1-18 })
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -2761,7 +2761,7 @@ instance ExactPrint (Sig GhcPs) where
(an0, vars',ty') <- exactVarSig an vars ty
return (ClassOpSig an0 is_deflt vars' ty')
- exact (FixSig an (FixitySig x names (Fixity src v fdir))) = do
+ exact (FixSig (an,src) (FixitySig x names (Fixity v fdir))) = do
let fixstr = case fdir of
InfixL -> "infixl"
InfixR -> "infixr"
@@ -2769,7 +2769,7 @@ instance ExactPrint (Sig GhcPs) where
an0 <- markEpAnnLMS'' an lidl AnnInfix (Just fixstr)
an1 <- markEpAnnLMS'' an0 lidl AnnVal (Just (sourceTextToString src (show v)))
names' <- markAnnotated names
- return (FixSig an1 (FixitySig x names' (Fixity src v fdir)))
+ return (FixSig (an1,src) (FixitySig x names' (Fixity v fdir)))
exact (InlineSig an ln inl) = do
an0 <- markAnnOpen an (inl_src inl) "{-# INLINE"
=====================================
utils/genprimopcode/Main.hs
=====================================
@@ -364,7 +364,7 @@ gen_hs_source (Info defaults entries) =
prim_fixity options n
= [ pprFixityDir d ++ " " ++ show i ++ " " ++ asInfix n
- | OptionFixity (Just (Fixity _ i d)) <- options ]
+ | OptionFixity (Just (Fixity i d)) <- options ]
prim_func n t = [ wrapOp n ++ " :: " ++ pprTy t,
wrapOp n ++ " = " ++ funcRhs n ]
=====================================
utils/genprimopcode/Parser.y
=====================================
@@ -90,9 +90,9 @@ pOption : lowerName '=' false { OptionFalse $1 }
| can_fail_warning '=' pPrimOpCanFailWarnFlag { OptionCanFailWarnFlag $3 }
pInfix :: { Maybe Fixity }
-pInfix : infix integer { Just $ Fixity NoSourceText $2 InfixN }
- | infixl integer { Just $ Fixity NoSourceText $2 InfixL }
- | infixr integer { Just $ Fixity NoSourceText $2 InfixR }
+pInfix : infix integer { Just $ Fixity $2 InfixN }
+ | infixl integer { Just $ Fixity $2 InfixL }
+ | infixr integer { Just $ Fixity $2 InfixR }
| nothing { Nothing }
pEffect :: { PrimOpEffect }
=====================================
utils/genprimopcode/Syntax.hs
=====================================
@@ -101,16 +101,12 @@ instance Show TyCon where
-- The SourceText exists so that it matches the SourceText field in
-- BasicTypes.Fixity
-data Fixity = Fixity SourceText Int FixityDirection
+data Fixity = Fixity Int FixityDirection
deriving (Eq, Show)
data FixityDirection = InfixN | InfixL | InfixR
deriving (Eq, Show)
-data SourceText = SourceText String
- | NoSourceText
- deriving (Eq,Show)
-
data PrimOpEffect
= NoEffect
| CanFail
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
=====================================
@@ -372,7 +372,7 @@ ppFixities fs qual = foldr1 (+++) (map ppFix uniq_fs) +++ rightEdge
uniq_fs =
[ (n, the p, the d')
- | (n, Fixity _ p d) <- fs
+ | (n, Fixity p d) <- fs
, let d' = ppDir d
, then group by
Down (p, d')
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
=====================================
@@ -57,7 +57,6 @@ import Data.Traversable (for)
import Control.Arrow (first, (&&&))
import GHC hiding (lookupName)
import GHC.Builtin.Names
-import GHC.Builtin.Types
import GHC.Builtin.Types.Prim
import GHC.Core.ConLike (ConLike (..))
import GHC.Data.FastString (FastString, bytesFS, unpackFS)
@@ -65,7 +64,6 @@ import GHC.Driver.Ppr
import GHC.HsToCore.Docs hiding (mkMaps)
import GHC.Iface.Syntax
import GHC.Types.Avail
-import GHC.Types.Basic
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.SafeHaskell
=====================================
utils/haddock/haddock-api/src/Haddock/Interface/Json.hs
=====================================
@@ -241,7 +241,7 @@ jsonName :: Name -> JsonDoc
jsonName = JSString . nameStableString
jsonFixity :: Fixity -> JsonDoc
-jsonFixity (Fixity _ prec dir) =
+jsonFixity (Fixity prec dir) =
jsonObject
[ ("prec", jsonInt prec)
, ("direction", jsonFixityDirection dir)
=====================================
utils/haddock/haddock-api/src/Haddock/Types.hs
=====================================
@@ -978,8 +978,8 @@ instance NFData FixityDirection where
rnf InfixN = ()
instance NFData Fixity where
- rnf (Fixity sourceText n dir) =
- sourceText `deepseq` n `deepseq` dir `deepseq` ()
+ rnf (Fixity n dir) =
+ n `deepseq` dir `deepseq` ()
instance NFData (EpAnn NameAnn) where
rnf (EpAnn en ann cs) = en `deepseq` ann `deepseq` cs `deepseq` ()
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8efafc068066e1dbbd95b6443bd08e0543f0c77b...72bacf3f58473d1956e2524be82864f34406b076
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8efafc068066e1dbbd95b6443bd08e0543f0c77b...72bacf3f58473d1956e2524be82864f34406b076
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/20240619/3bd66444/attachment-0001.html>
More information about the ghc-commits
mailing list