[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 4 commits: Assorted changes to avoid Data.List.{head,tail}
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Jan 30 07:36:34 UTC 2023
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
2b62739d by Bodigrim at 2023-01-28T17:16:11-05:00
Assorted changes to avoid Data.List.{head,tail}
- - - - -
78c07219 by Cheng Shao at 2023-01-28T17:16:48-05:00
compiler: properly handle ForeignHints in the wasm NCG
Properly handle ForeignHints of ccall arguments/return value, insert
sign extends and truncations when handling signed subwords. Fixes #22852.
- - - - -
b4b0aca7 by Ben Gamari at 2023-01-30T02:36:21-05:00
nativeGen: Disable asm-shortcutting on Darwin
Asm-shortcutting may produce relative references to symbols defined in
other compilation units. This is not something that MachO relocations
support (see #21972). For this reason we disable the optimisation on
Darwin. We do so without a warning since this flag is enabled by `-O2`.
Another way to address this issue would be to rather implement a
PLT-relocatable jump-table strategy. However, this would only benefit
Darwin and does not seem worth the effort.
Closes #21972.
- - - - -
ed9a457e by Cheng Shao at 2023-01-30T02:36:22-05:00
compiler: fix data section alignment in the wasm NCG
Previously we tried to lower the alignment requirement as far as
possible, based on the section kind inferred from the CLabel. For info
tables, .p2align 1 was applied given the GC should only need the
lowest bit to tag forwarding pointers. But this would lead to
unaligned loads/stores, which has a performance penalty even if the
wasm spec permits it. Furthermore, the test suite has shown memory
corruption in a few cases when compacting gc is used.
This patch takes a more conservative approach: all data sections
except C strings align to word size.
- - - - -
14 changed files:
- compiler/GHC/CmmToAsm.hs
- compiler/GHC/CmmToAsm/BlockLayout.hs
- compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/JS/Make.hs
- compiler/GHC/StgToJS/Linker/Linker.hs
- compiler/GHC/Utils/Misc.hs
- docs/users_guide/using-optimisation.rst
- libraries/base/Data/Data.hs
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Main.hs
- utils/check-exact/Preprocess.hs
- utils/check-exact/Transform.hs
- utils/check-exact/Utils.hs
Changes:
=====================================
compiler/GHC/CmmToAsm.hs
=====================================
@@ -812,6 +812,19 @@ generateJumpTables ncgImpl xs = concatMap f xs
-- -----------------------------------------------------------------------------
-- Shortcut branches
+-- Note [No asm-shortcutting on Darwin]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Asm-shortcutting may produce relative references to symbols defined in
+-- other compilation units. This is not something that MachO relocations
+-- support (see #21972). For this reason we disable the optimisation on Darwin.
+-- We do so in the backend without a warning since this flag is enabled by
+-- `-O2`.
+--
+-- Another way to address this issue would be to rather implement a
+-- PLT-relocatable jump-table strategy. However, this would only benefit Darwin
+-- and does not seem worth the effort as this optimisation generally doesn't
+-- offer terribly great benefits.
+
shortcutBranches
:: forall statics instr jumpDest. (Outputable jumpDest)
=> NCGConfig
@@ -822,6 +835,8 @@ shortcutBranches
shortcutBranches config ncgImpl tops weights
| ncgEnableShortcutting config
+ -- See Note [No asm-shortcutting on Darwin]
+ , not $ osMachOTarget $ platformOS $ ncgPlatform config
= ( map (apply_mapping ncgImpl mapping) tops'
, shortcutWeightMap mappingBid <$!> weights )
| otherwise
=====================================
compiler/GHC/CmmToAsm/BlockLayout.hs
=====================================
@@ -14,6 +14,7 @@ module GHC.CmmToAsm.BlockLayout
where
import GHC.Prelude hiding (head, init, last, tail)
+import qualified GHC.Prelude as Partial (head, tail)
import GHC.Platform
@@ -41,7 +42,6 @@ import GHC.Utils.Panic.Plain
import GHC.Utils.Misc
import Data.List (sortOn, sortBy, nub)
-import qualified Data.List as Partial (head, tail)
import Data.List.NonEmpty (nonEmpty)
import qualified Data.List.NonEmpty as NE
import Data.Foldable (toList)
=====================================
compiler/GHC/CmmToAsm/Wasm/FromCmm.hs
=====================================
@@ -7,6 +7,7 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE Strict #-}
+{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UndecidableInstances #-}
@@ -122,15 +123,15 @@ alignmentFromWordType TagI32 = mkAlignment 4
alignmentFromWordType TagI64 = mkAlignment 8
alignmentFromWordType _ = panic "alignmentFromWordType: unreachable"
--- | Calculate a data section's alignment. Closures needs to be
--- naturally aligned; info tables need to align to 2, so to get 1 tag
--- bit as forwarding pointer marker. The rest have no alignment
--- requirements.
-alignmentFromCmmSection :: WasmTypeTag w -> CLabel -> Alignment
-alignmentFromCmmSection t lbl
- | isStaticClosureLabel lbl = alignmentFromWordType t
- | isInfoTableLabel lbl = mkAlignment 2
- | otherwise = mkAlignment 1
+-- | Calculate a data section's alignment. As a conservative
+-- optimization, a data section with a single CmmString/CmmFileEmbed
+-- has no alignment requirement, otherwise we always align to the word
+-- size to satisfy pointer tagging requirements and avoid unaligned
+-- loads/stores.
+alignmentFromCmmSection :: WasmTypeTag w -> [DataSectionContent] -> Alignment
+alignmentFromCmmSection _ [DataASCII {}] = mkAlignment 1
+alignmentFromCmmSection _ [DataIncBin {}] = mkAlignment 1
+alignmentFromCmmSection t _ = alignmentFromWordType t
-- | Lower a 'CmmStatic'.
lower_CmmStatic :: CmmStatic -> WasmCodeGenM w DataSectionContent
@@ -1203,6 +1204,7 @@ lower_CallishMachOp lbl (MO_Memcmp {}) rs xs =
lower_CmmUnsafeForeignCall
lbl
(Left "memcmp")
+ Nothing
CmmMayReturn
rs
xs
@@ -1210,6 +1212,7 @@ lower_CallishMachOp lbl (MO_PopCnt w0) rs xs =
lower_CmmUnsafeForeignCall
lbl
(Left $ fromString $ "hs_popcnt" <> show (widthInBits w0))
+ Nothing
CmmMayReturn
rs
xs
@@ -1217,6 +1220,7 @@ lower_CallishMachOp lbl (MO_Pdep w0) rs xs =
lower_CmmUnsafeForeignCall
lbl
(Left $ fromString $ "hs_pdep" <> show (widthInBits w0))
+ Nothing
CmmMayReturn
rs
xs
@@ -1224,6 +1228,7 @@ lower_CallishMachOp lbl (MO_Pext w0) rs xs =
lower_CmmUnsafeForeignCall
lbl
(Left $ fromString $ "hs_pext" <> show (widthInBits w0))
+ Nothing
CmmMayReturn
rs
xs
@@ -1231,6 +1236,7 @@ lower_CallishMachOp lbl (MO_Clz w0) rs xs =
lower_CmmUnsafeForeignCall
lbl
(Left $ fromString $ "hs_clz" <> show (widthInBits w0))
+ Nothing
CmmMayReturn
rs
xs
@@ -1238,6 +1244,7 @@ lower_CallishMachOp lbl (MO_Ctz w0) rs xs =
lower_CmmUnsafeForeignCall
lbl
(Left $ fromString $ "hs_ctz" <> show (widthInBits w0))
+ Nothing
CmmMayReturn
rs
xs
@@ -1245,6 +1252,7 @@ lower_CallishMachOp lbl (MO_BSwap w0) rs xs =
lower_CmmUnsafeForeignCall
lbl
(Left $ fromString $ "hs_bswap" <> show (widthInBits w0))
+ Nothing
CmmMayReturn
rs
xs
@@ -1252,6 +1260,7 @@ lower_CallishMachOp lbl (MO_BRev w0) rs xs =
lower_CmmUnsafeForeignCall
lbl
(Left $ fromString $ "hs_bitrev" <> show (widthInBits w0))
+ Nothing
CmmMayReturn
rs
xs
@@ -1270,6 +1279,7 @@ lower_CallishMachOp lbl (MO_AtomicRMW w0 op) rs xs =
)
<> show (widthInBits w0)
)
+ Nothing
CmmMayReturn
rs
xs
@@ -1289,6 +1299,7 @@ lower_CallishMachOp lbl (MO_Xchg w0) rs xs =
lower_CmmUnsafeForeignCall
lbl
(Left $ fromString $ "hs_xchg" <> show (widthInBits w0))
+ Nothing
CmmMayReturn
rs
xs
@@ -1296,6 +1307,7 @@ lower_CallishMachOp lbl MO_SuspendThread rs xs =
lower_CmmUnsafeForeignCall
lbl
(Left "suspendThread")
+ Nothing
CmmMayReturn
rs
xs
@@ -1303,6 +1315,7 @@ lower_CallishMachOp lbl MO_ResumeThread rs xs =
lower_CmmUnsafeForeignCall
lbl
(Left "resumeThread")
+ Nothing
CmmMayReturn
rs
xs
@@ -1324,6 +1337,7 @@ lower_CmmUnsafeForeignCall_Drop lbl sym_callee ret_cmm_ty arg_exprs = do
lower_CmmUnsafeForeignCall
lbl
(Left sym_callee)
+ Nothing
CmmMayReturn
[ret_local]
arg_exprs
@@ -1335,34 +1349,52 @@ lower_CmmUnsafeForeignCall_Drop lbl sym_callee ret_cmm_ty arg_exprs = do
lower_CmmUnsafeForeignCall ::
CLabel ->
(Either SymName CmmExpr) ->
+ Maybe
+ ([ForeignHint], [ForeignHint]) ->
CmmReturnInfo ->
[CmmFormal] ->
[CmmActual] ->
- WasmCodeGenM
- w
- (WasmStatements w)
-lower_CmmUnsafeForeignCall lbl target ret_info ret_locals arg_exprs = do
+ WasmCodeGenM w (WasmStatements w)
+lower_CmmUnsafeForeignCall lbl target mb_hints ret_info ret_locals arg_exprs = do
+ platform <- wasmPlatformM
SomeWasmPreCCall arg_tys args_instr <-
foldrM
- ( \arg_expr (SomeWasmPreCCall acc_tys acc_instr) -> do
- SomeWasmExpr arg_ty (WasmExpr arg_instr) <-
- lower_CmmExpr lbl arg_expr
+ ( \(arg_expr, arg_hint) (SomeWasmPreCCall acc_tys acc_instr) -> do
+ SomeWasmExpr arg_ty arg_wasm_expr <- lower_CmmExpr lbl arg_expr
+ let WasmExpr arg_instr = case arg_hint of
+ SignedHint ->
+ extendSubword
+ (cmmExprWidth platform arg_expr)
+ arg_ty
+ arg_wasm_expr
+ _ -> arg_wasm_expr
pure $
SomeWasmPreCCall (arg_ty `TypeListCons` acc_tys) $
arg_instr `WasmConcat` acc_instr
)
(SomeWasmPreCCall TypeListNil WasmNop)
- arg_exprs
+ arg_exprs_hints
SomeWasmPostCCall ret_tys ret_instr <-
foldrM
- ( \reg (SomeWasmPostCCall acc_tys acc_instr) -> do
+ ( \(reg, ret_hint) (SomeWasmPostCCall acc_tys acc_instr) -> do
(reg_i, SomeWasmType reg_ty) <- onCmmLocalReg reg
pure $
SomeWasmPostCCall (reg_ty `TypeListCons` acc_tys) $
- acc_instr `WasmConcat` WasmLocalSet reg_ty reg_i
+ case (# ret_hint, cmmRegWidth platform $ CmmLocal reg #) of
+ (# SignedHint, W8 #) ->
+ acc_instr
+ `WasmConcat` WasmConst reg_ty 0xFF
+ `WasmConcat` WasmAnd reg_ty
+ `WasmConcat` WasmLocalSet reg_ty reg_i
+ (# SignedHint, W16 #) ->
+ acc_instr
+ `WasmConcat` WasmConst reg_ty 0xFFFF
+ `WasmConcat` WasmAnd reg_ty
+ `WasmConcat` WasmLocalSet reg_ty reg_i
+ _ -> acc_instr `WasmConcat` WasmLocalSet reg_ty reg_i
)
(SomeWasmPostCCall TypeListNil WasmNop)
- ret_locals
+ ret_locals_hints
case target of
Left sym_callee -> do
platform <- wasmPlatformM
@@ -1388,6 +1420,11 @@ lower_CmmUnsafeForeignCall lbl target ret_info ret_locals arg_exprs = do
CmmMayReturn -> ret_instr
CmmNeverReturns -> WasmUnreachable
)
+ where
+ (# arg_exprs_hints, ret_locals_hints #) = case mb_hints of
+ Just (arg_hints, ret_hints) ->
+ (# zip arg_exprs arg_hints, zip ret_locals ret_hints #)
+ _ -> (# map (,NoHint) arg_exprs, map (,NoHint) ret_locals #)
-- | Lower a 'CmmStore'.
lower_CmmStore ::
@@ -1443,7 +1480,7 @@ lower_CmmAction lbl act = do
CmmUnsafeForeignCall
( ForeignTarget
(CmmLit (CmmLabel lbl_callee))
- (ForeignConvention conv _ _ ret_info)
+ (ForeignConvention conv arg_hints ret_hints ret_info)
)
ret_locals
arg_exprs
@@ -1451,17 +1488,19 @@ lower_CmmAction lbl act = do
lower_CmmUnsafeForeignCall
lbl
(Left $ symNameFromCLabel lbl_callee)
+ (Just (arg_hints, ret_hints))
ret_info
ret_locals
arg_exprs
CmmUnsafeForeignCall
- (ForeignTarget target_expr (ForeignConvention conv _ _ ret_info))
+ (ForeignTarget target_expr (ForeignConvention conv arg_hints ret_hints ret_info))
ret_locals
arg_exprs
| conv `elem` [CCallConv, CApiConv] ->
lower_CmmUnsafeForeignCall
lbl
(Right target_expr)
+ (Just (arg_hints, ret_hints))
ret_info
ret_locals
arg_exprs
@@ -1611,7 +1650,7 @@ onCmmData lbl s statics = do
{ dataSectionKind =
dataSectionKindFromCmmSection s,
dataSectionAlignment =
- alignmentFromCmmSection ty_word lbl,
+ alignmentFromCmmSection ty_word cs,
dataSectionContents =
case cs of
[DataASCII buf] -> [DataASCII $ buf `BS.snoc` 0]
=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -43,6 +43,7 @@ module GHC.Core.Opt.Simplify.Utils (
) where
import GHC.Prelude hiding (head, init, last, tail)
+import qualified GHC.Prelude as Partial (head)
import GHC.Core
import GHC.Types.Literal ( isLitRubbish )
@@ -84,7 +85,6 @@ import GHC.Utils.Panic.Plain
import Control.Monad ( when )
import Data.List ( sortBy )
-import qualified Data.List as Partial ( head )
{- *********************************************************************
* *
=====================================
compiler/GHC/JS/Make.hs
=====================================
@@ -141,7 +141,6 @@ import Control.Arrow ((***))
import Data.Array
import qualified Data.Map as M
-import qualified Data.List as List
import GHC.Utils.Outputable (Outputable (..))
import GHC.Data.FastString
@@ -277,21 +276,21 @@ jVar f = UnsatBlock . IS $ do
jForIn :: ToSat a => JExpr -> (JExpr -> a) -> JStat
jForIn e f = UnsatBlock . IS $ do
(block, is) <- runIdentSupply $ toSat_ f []
- let i = List.head is
+ let i = head is
return $ decl i `mappend` ForInStat False i e block
-- | As with "jForIn" but creating a \"for each in\" statement.
jForEachIn :: ToSat a => JExpr -> (JExpr -> a) -> JStat
jForEachIn e f = UnsatBlock . IS $ do
(block, is) <- runIdentSupply $ toSat_ f []
- let i = List.head is
+ let i = head is
return $ decl i `mappend` ForInStat True i e block
-- | As with "jForIn" but creating a \"for each in\" statement.
jTryCatchFinally :: (ToSat a) => JStat -> a -> JStat -> JStat
jTryCatchFinally s f s2 = UnsatBlock . IS $ do
(block, is) <- runIdentSupply $ toSat_ f []
- let i = List.head is
+ let i = head is
return $ TryStat s i block s2
-- | construct a JS variable reference
=====================================
compiler/GHC/StgToJS/Linker/Linker.hs
=====================================
@@ -84,9 +84,10 @@ import Data.Function (on)
import Data.IntSet (IntSet)
import qualified Data.IntSet as IS
import Data.IORef
-import Data.List ( partition, nub, intercalate, group, sort
+import Data.List ( partition, nub, intercalate, sort
, groupBy, intersperse,
)
+import qualified Data.List.NonEmpty as NE
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as M
import Data.Maybe
@@ -228,7 +229,7 @@ computeLinkDependencies cfg logger target unit_env units objFiles extraStaticDep
(objDepsMap, objRequiredUnits) <- loadObjDeps objFiles
let roots = S.fromList . filter isRootFun $ concatMap (M.keys . depsHaskellExported . fst) (M.elems objDepsMap)
- rootMods = map (moduleNameString . moduleName . head) . group . sort . map funModule . S.toList $ roots
+ rootMods = map (moduleNameString . moduleName . NE.head) . NE.group . sort . map funModule . S.toList $ roots
objPkgs = map moduleUnitId $ nub (M.keys objDepsMap)
when (logVerbAtLeast logger 2) $ void $ do
=====================================
compiler/GHC/Utils/Misc.hs
=====================================
@@ -121,6 +121,7 @@ module GHC.Utils.Misc (
) where
import GHC.Prelude.Basic hiding ( head, init, last, tail )
+import qualified GHC.Prelude.Basic as Partial ( head )
import GHC.Utils.Exception
import GHC.Utils.Panic.Plain
@@ -129,7 +130,6 @@ import GHC.Utils.Fingerprint
import Data.Data
import qualified Data.List as List
-import qualified Data.List as Partial ( head )
import Data.List.NonEmpty ( NonEmpty(..), last, nonEmpty )
import qualified Data.List.NonEmpty as NE
=====================================
docs/users_guide/using-optimisation.rst
=====================================
@@ -262,8 +262,10 @@ by saying ``-fno-wombat``.
of a unconditionally jump, we replace all jumps to A by jumps to the successor
of A.
- This is mostly done during Cmm passes. However this can miss corner cases. So at -O2
- we run the pass again at the asm stage to catch these.
+ This is mostly done during Cmm passes. However this can miss corner cases.
+ So at ``-O2`` this flag runs the pass again at the assembly stage to catch
+ these. Note that due to platform limitations (:ghc-ticket:`21972`) this flag
+ does nothing on macOS.
.. ghc-flag:: -fblock-layout-cfg
:shortdesc: Use the new cfg based block layout algorithm.
=====================================
libraries/base/Data/Data.hs
=====================================
@@ -704,10 +704,9 @@ readConstr dt str =
-- Traverse list of algebraic datatype constructors
idx :: [Constr] -> Maybe Constr
- idx cons = let fit = filter ((==) str . showConstr) cons
- in if fit == []
- then Nothing
- else Just (head fit)
+ idx cons = case filter ((==) str . showConstr) cons of
+ [] -> Nothing
+ hd : _ -> Just hd
ffloat :: Double -> Constr
ffloat = mkPrimCon dt str . FloatConstr . toRational
@@ -850,17 +849,17 @@ isNorepType dt = case datarep dt of
-- drop *.*.*... before name
--
tyconUQname :: String -> String
-tyconUQname x = let x' = dropWhile (not . (==) '.') x
- in if x' == [] then x else tyconUQname (tail x')
+tyconUQname x = case dropWhile (not . (==) '.') x of
+ [] -> x
+ _ : tl -> tyconUQname tl
-- | Gets the module of a type constructor:
-- take *.*.*... before name
tyconModule :: String -> String
-tyconModule x = let (a,b) = break ((==) '.') x
- in if b == ""
- then b
- else a ++ tyconModule' (tail b)
+tyconModule x = case break ((==) '.') x of
+ (_, "") -> ""
+ (a, _ : tl) -> a ++ tyconModule' tl
where
tyconModule' y = let y' = tyconModule y
in if y' == "" then "" else ('.':y')
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -3696,12 +3696,13 @@ exactVanillaDeclHead :: (Monad m, Monoid w)
exactVanillaDeclHead thing tvs@(HsQTvs { hsq_explicit = tyvars }) fixity context = do
let
exact_tyvars (varl:varsr)
- | fixity == Infix && length varsr > 1 = do
+ | hvarsr : tvarsr@(_ : _) <- varsr
+ , fixity == Infix = do
varl' <- markAnnotated varl
thing' <- markAnnotated thing
- hvarsr <- markAnnotated (head varsr)
- tvarsr <- markAnnotated (tail varsr)
- return (thing', varl':hvarsr:tvarsr)
+ hvarsr' <- markAnnotated hvarsr
+ tvarsr' <- markAnnotated tvarsr
+ return (thing', varl':hvarsr':tvarsr')
| fixity == Infix = do
varl' <- markAnnotated varl
thing' <- markAnnotated thing
=====================================
utils/check-exact/Main.hs
=====================================
@@ -577,11 +577,11 @@ changeWhereIn3b :: Changer
changeWhereIn3b _libdir (L l p) = do
let decls0 = hsmodDecls p
(decls,_,w) = runTransform (balanceCommentsList decls0)
- (de0:_:de1:d2:_) = decls
+ (de0:tdecls@(_:de1:d2:_)) = decls
de0' = setEntryDP de0 (DifferentLine 2 0)
de1' = setEntryDP de1 (DifferentLine 2 0)
d2' = setEntryDP d2 (DifferentLine 2 0)
- decls' = d2':de1':de0':(tail decls)
+ decls' = d2':de1':de0':tdecls
debugM $ unlines w
debugM $ "changeWhereIn3b:de1':" ++ showAst de1'
let p2 = p { hsmodDecls = decls'}
@@ -799,8 +799,9 @@ rmDecl5 _libdir lp = do
go :: HsExpr GhcPs -> Transform (HsExpr GhcPs)
go (HsLet a tkLet lb tkIn expr) = do
decs <- hsDeclsValBinds lb
+ let hdecs : _ = decs
let dec = last decs
- _ <- transferEntryDP (head decs) dec
+ _ <- transferEntryDP hdecs dec
lb' <- replaceDeclsValbinds WithoutWhere lb [dec]
return (HsLet a tkLet lb' tkIn expr)
go x = return x
=====================================
utils/check-exact/Preprocess.hs
=====================================
@@ -192,7 +192,7 @@ stripPreprocessorDirectives :: GHC.StringBuffer -> GHC.StringBuffer
stripPreprocessorDirectives buf = buf'
where
srcByLine = lines $ sbufToString buf
- noDirectivesLines = map (\line -> if line /= [] && head line == '#' then "" else line) srcByLine
+ noDirectivesLines = map (\line -> case line of '#' : _ -> ""; _ -> line) srcByLine
buf' = GHC.stringToStringBuffer $ unlines noDirectivesLines
-- ---------------------------------------------------------------------
@@ -259,7 +259,7 @@ fingerprintStrings ss = GHC.fingerprintFingerprints $ map GHC.fingerprintString
getPreprocessorAsComments :: FilePath -> IO [(GHC.Located GHC.Token, String)]
getPreprocessorAsComments srcFile = do
fcontents <- readFileGhc srcFile
- let directives = filter (\(_lineNum,line) -> line /= [] && head line == '#')
+ let directives = filter (\(_lineNum,line) -> case line of '#' : _ -> True; _ -> False)
$ zip [1..] (lines fcontents)
let mkTok (lineNum,line) = (GHC.L l (GHC.ITlineComment line (makeBufSpan l)),line)
=====================================
utils/check-exact/Transform.hs
=====================================
@@ -322,7 +322,7 @@ setEntryDP (L (SrcSpanAnn (EpAnn (Anchor r _) an cs) l) a) dp
l) a
where
cs'' = setPriorComments cs (L (Anchor (anchor ca) (MovedAnchor dp)) c:cs')
- lc = head $ reverse $ (L ca c:cs')
+ lc = last $ (L ca c:cs')
delta = tweakDelta $ ss2delta (ss2pos $ anchor $ getLoc lc) r
line = getDeltaLine delta
col = deltaColumn delta
=====================================
utils/check-exact/Utils.hs
=====================================
@@ -458,8 +458,8 @@ glast info [] = error $ "glast " ++ info ++ " []"
glast _info h = last h
gtail :: String -> [a] -> [a]
-gtail info [] = error $ "gtail " ++ info ++ " []"
-gtail _info h = tail h
+gtail info [] = error $ "gtail " ++ info ++ " []"
+gtail _info (_:t) = t
gfromJust :: String -> Maybe a -> a
gfromJust _info (Just h) = h
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6fad9951f19f6d17f52e927b367e873d1d577cdc...ed9a457ed92ca12a805526100581fa23b9c05b2b
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/6fad9951f19f6d17f52e927b367e873d1d577cdc...ed9a457ed92ca12a805526100581fa23b9c05b2b
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/20230130/6aca7fbe/attachment-0001.html>
More information about the ghc-commits
mailing list