From d77d94c2a556f4312fe39b7c0649ba12d4429766 Mon Sep 17 00:00:00 2001 From: Shayne Fletcher Date: Sat, 26 Mar 2022 10:46:19 -0400 Subject: [PATCH] updates for compatibility with GHC `HEAD` --- src/Config/Compute.hs | 4 ++-- src/Config/Yaml.hs | 2 +- src/GHC/Util/FreeVars.hs | 10 +++++----- src/GHC/Util/HsExpr.hs | 10 +++++----- src/GHC/Util/View.hs | 4 ++-- src/Hint/Export.hs | 4 ++-- src/Hint/Extensions.hs | 7 ++++--- src/Hint/Fixities.hs | 1 - src/Hint/Lambda.hs | 10 +++++----- src/Hint/ListRec.hs | 6 +++--- src/Hint/Monad.hs | 2 +- src/Hint/Naming.hs | 2 +- src/Hint/Negation.hs | 2 +- src/Hint/NumLiteral.hs | 17 +++++++++-------- src/Hint/Unsafe.hs | 6 ++++-- 15 files changed, 45 insertions(+), 42 deletions(-) diff --git a/src/Config/Compute.hs b/src/Config/Compute.hs index 43973b42e..8202c6e90 100644 --- a/src/Config/Compute.hs +++ b/src/Config/Compute.hs @@ -53,11 +53,11 @@ findSetting x = [] findBind :: HsBind GhcPs -> [Setting] findBind VarBind{var_id, var_rhs} = findExp var_id [] $ unLoc var_rhs -findBind FunBind{fun_id, fun_matches} = findExp (unLoc fun_id) [] $ HsLam noExtField fun_matches +findBind FunBind{fun_id, fun_matches} = findExp (unLoc fun_id) [] $ HsLam EpAnnNotUsed LamSingle fun_matches findBind _ = [] findExp :: IdP GhcPs -> [String] -> HsExpr GhcPs -> [Setting] -findExp name vs (HsLam _ MG{mg_alts=L _ [L _ Match{m_pats, m_grhss=GRHSs{grhssGRHSs=[L _ (GRHS _ [] x)], grhssLocalBinds=(EmptyLocalBinds _)}}]}) +findExp name vs (HsLam _ LamSingle MG{mg_alts=L _ [L _ Match{m_pats, m_grhss=GRHSs{grhssGRHSs=[L _ (GRHS _ [] x)], grhssLocalBinds=(EmptyLocalBinds _)}}]}) = if length m_pats == length ps then findExp name (vs++ps) $ unLoc x else [] where ps = [rdrNameStr x | L _ (VarPat _ x) <- m_pats] findExp name vs HsLam{} = [] diff --git a/src/Config/Yaml.hs b/src/Config/Yaml.hs index 71e23229d..4532f68b2 100644 --- a/src/Config/Yaml.hs +++ b/src/Config/Yaml.hs @@ -163,7 +163,7 @@ parseFail (Val focus path) msg = fail $ -- aim to show a smallish but relevant context dotDot (fromMaybe (encode focus) $ listToMaybe $ dropWhile (\x -> BS.length x > 250) $ map encode contexts) where - (steps, contexts) = unzip $ reverse path + (steps, contexts) = Prelude.unzip $ reverse path dotDot x = let (a,b) = BS.splitAt 250 x in BS.unpack a ++ (if BS.null b then "" else "...") parseArray :: Val -> Parser [Val] diff --git a/src/GHC/Util/FreeVars.hs b/src/GHC/Util/FreeVars.hs index 8c6f2396b..f57abad5f 100644 --- a/src/GHC/Util/FreeVars.hs +++ b/src/GHC/Util/FreeVars.hs @@ -99,8 +99,8 @@ unqualNames _ = [] instance FreeVars (LocatedA (HsExpr GhcPs)) where freeVars (L _ (HsVar _ x)) = Set.fromList $ unqualNames x -- Variable. freeVars (L _ (HsUnboundVar _ x)) = Set.fromList [rdrNameOcc x] -- Unbound variable; also used for "holes". - freeVars (L _ (HsLam _ mg)) = free (allVars mg) -- Lambda abstraction. Currently always a single match. - freeVars (L _ (HsLamCase _ _ MG{mg_alts=(L _ ms)})) = free (allVars ms) -- Lambda case + freeVars (L _ (HsLam _ LamSingle mg)) = free (allVars mg) -- Lambda abstraction. Currently always a single match. + freeVars (L _ (HsLam _ _ MG{mg_alts=(L _ ms)})) = free (allVars ms) -- Lambda case freeVars (L _ (HsCase _ of_ MG{mg_alts=(L _ ms)})) = freeVars of_ ^+ free (allVars ms) -- Case expr. freeVars (L _ (HsLet _ _ binds _ e)) = inFree binds e -- Let (rec). freeVars (L _ (HsDo _ ctxt (L _ stmts))) = snd $ foldl' alg mempty stmts -- Do block. @@ -122,8 +122,8 @@ instance FreeVars (LocatedA (HsExpr GhcPs)) where freeVars (L _ (RecordCon _ _ (HsRecFields flds _))) = Set.unions $ map freeVars flds -- Record construction. freeVars (L _ (RecordUpd _ e flds)) = case flds of - Left fs -> Set.unions $ freeVars e : map freeVars fs - Right ps -> Set.unions $ freeVars e : map freeVars ps + RegularRecUpdFields _ fs -> Set.unions $ freeVars e : map freeVars fs + OverloadedRecUpdFields _ ps -> Set.unions $ freeVars e : map freeVars ps freeVars (L _ (HsMultiIf _ grhss)) = free (allVars grhss) -- Multi-way if. freeVars (L _ (HsTypedBracket _ e)) = freeVars e freeVars (L _ (HsUntypedBracket _ (ExpBr _ e))) = freeVars e @@ -174,7 +174,7 @@ instance FreeVars (LocatedA (HsFieldBind (LocatedAn NoEpAnns (FieldOcc GhcPs)) ( freeVars o@(L _ (HsFieldBind _ _ x _)) = freeVars x instance FreeVars (LocatedA (HsFieldBind (LocatedAn NoEpAnns (AmbiguousFieldOcc GhcPs)) (LocatedA (HsExpr GhcPs)))) where - freeVars (L _ (HsFieldBind _ x _ True)) = Set.singleton $ rdrNameOcc $ rdrNameAmbiguousFieldOcc $ unLoc x -- a pun + freeVars (L _ (HsFieldBind _ x _ True)) = Set.singleton $ rdrNameOcc $ ambiguousFieldOccRdrName $ unLoc x -- a pun freeVars (L _ (HsFieldBind _ _ x _)) = freeVars x instance FreeVars (LocatedA (HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) (LocatedA (HsExpr GhcPs)))) where diff --git a/src/GHC/Util/HsExpr.hs b/src/GHC/Util/HsExpr.hs index 5a87a6452..69b49f826 100644 --- a/src/GHC/Util/HsExpr.hs +++ b/src/GHC/Util/HsExpr.hs @@ -58,7 +58,7 @@ dotApps (x : xs) = dotApp x (dotApps xs) -- | @lambda [p0, p1..pn] body@ makes @\p1 p1 .. pn -> body@ lambda :: [LPat GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs -lambda vs body = noLocA $ HsLam noExtField (MG Generated (noLocA [noLocA $ Match EpAnnNotUsed LambdaExpr vs (GRHSs emptyComments [noLocA $ GRHS EpAnnNotUsed [] body] (EmptyLocalBinds noExtField))])) +lambda vs body = noLocA $ HsLam EpAnnNotUsed LamSingle (MG (Generated DoPmc) (noLocA [noLocA $ Match EpAnnNotUsed (LamAlt LamSingle) vs (GRHSs emptyComments [noLocA $ GRHS EpAnnNotUsed [] body] (EmptyLocalBinds noExtField))])) -- | 'paren e' wraps 'e' in parens if 'e' is non-atomic. paren :: LHsExpr GhcPs -> LHsExpr GhcPs @@ -241,9 +241,9 @@ niceLambdaR [] e = (e, \s -> [Replace Expr s [("a", toSSA e)] "a"]) niceLambdaR ss e = let grhs = noLocA $ GRHS EpAnnNotUsed [] e :: LGRHS GhcPs (LHsExpr GhcPs) grhss = GRHSs {grhssExt = emptyComments, grhssGRHSs=[grhs], grhssLocalBinds=EmptyLocalBinds noExtField} - match = noLocA $ Match {m_ext=EpAnnNotUsed, m_ctxt=LambdaExpr, m_pats=map strToPat ss, m_grhss=grhss} :: LMatch GhcPs (LHsExpr GhcPs) - matchGroup = MG {mg_ext=Generated, mg_alts=noLocA [match]} - in (noLocA $ HsLam noExtField matchGroup, const []) + match = noLocA $ Match {m_ext=EpAnnNotUsed, m_ctxt=LamAlt LamSingle, m_pats=map strToPat ss, m_grhss=grhss} :: LMatch GhcPs (LHsExpr GhcPs) + matchGroup = MG {mg_ext=Generated DoPmc, mg_alts=noLocA [match]} + in (noLocA $ HsLam EpAnnNotUsed LamSingle matchGroup, const []) -- 'case' and 'if' expressions have branches, nothing else does (this @@ -252,7 +252,7 @@ replaceBranches :: LHsExpr GhcPs -> ([LHsExpr GhcPs], [LHsExpr GhcPs] -> LHsExpr replaceBranches (L l (HsIf _ a b c)) = ([b, c], \[b, c] -> L l (HsIf EpAnnNotUsed a b c)) replaceBranches (L s (HsCase _ a (MG FromSource (L l bs)))) = - (concatMap f bs, L s . HsCase EpAnnNotUsed a . MG Generated . L l . g bs) + (concatMap f bs, L s . HsCase EpAnnNotUsed a . MG (Generated DoPmc). L l . g bs) where f :: LMatch GhcPs (LHsExpr GhcPs) -> [LHsExpr GhcPs] f (L _ (Match _ CaseAlt _ (GRHSs _ xs _))) = [x | (L _ (GRHS _ _ x)) <- xs] diff --git a/src/GHC/Util/View.hs b/src/GHC/Util/View.hs index 0481de3d4..8a054dc40 100644 --- a/src/GHC/Util/View.hs +++ b/src/GHC/Util/View.hs @@ -32,7 +32,7 @@ data App2 = NoApp2 | App2 (LocatedA (HsExpr GhcPs)) (LocatedA (HsExpr GhcPs)) data LamConst1 = NoLamConst1 | LamConst1 (LocatedA (HsExpr GhcPs)) instance View (LocatedA (HsExpr GhcPs)) LamConst1 where - view (fromParen -> (L _ (HsLam _ (MG FromSource (L _ [L _ (Match _ LambdaExpr [L _ WildPat {}] + view (fromParen -> (L _ (HsLam _ _ (MG FromSource (L _ [L _ (Match _ (LamAlt _) [L _ WildPat {}] (GRHSs _ [L _ (GRHS _ [] x)] ((EmptyLocalBinds _))))]))))) = LamConst1 x view _ = NoLamConst1 @@ -62,4 +62,4 @@ instance View (LocatedA (Pat GhcPs)) PApp_ where -- A lambda with no guards and no where clauses pattern SimpleLambda :: [LocatedA (Pat GhcPs)] -> LocatedA (HsExpr GhcPs) -> LocatedA (HsExpr GhcPs) -pattern SimpleLambda vs body <- L _ (HsLam _ (MG _ (L _ [L _ (Match _ _ vs (GRHSs _ [L _ (GRHS _ [] body)] ((EmptyLocalBinds _))))]))) +pattern SimpleLambda vs body <- L _ (HsLam _ LamSingle (MG _ (L _ [L _ (Match _ _ vs (GRHSs _ [L _ (GRHS _ [] body)] ((EmptyLocalBinds _))))]))) diff --git a/src/Hint/Export.hs b/src/Hint/Export.hs index 5f08dfc89..bc029cbae 100644 --- a/src/Hint/Export.hs +++ b/src/Hint/Export.hs @@ -23,7 +23,7 @@ import GHC.Types.Name.Reader exportHint :: ModuHint exportHint _ (ModuleEx (L s m@HsModule {hsmodName = Just name, hsmodExports = exports}) ) | Nothing <- exports = - let r = o{ hsmodExports = Just (noLocA [noLocA (IEModuleContents EpAnnNotUsed name)] )} in + let r = o{ hsmodExports = Just (noLocA [noLocA (IEModuleContents (Nothing, EpAnnNotUsed) name)] )} in [(ignore "Use module export list" (L s o) (noLoc r) []){ideaNote = [Note "an explicit list is usually better"]}] | Just (L _ xs) <- exports , mods <- [x | x <- xs, isMod x] @@ -32,7 +32,7 @@ exportHint _ (ModuleEx (L s m@HsModule {hsmodName = Just name, hsmodExports = ex , exports' <- [x | x <- xs, not (matchesModName modName x)] , modName `elem` names = let dots = mkRdrUnqual (mkVarOcc " ... ") - r = o{ hsmodExports = Just (noLocA (noLocA (IEVar noExtField (noLocA (IEName noExtField (noLocA dots)))) : exports') )} + r = o{ hsmodExports = Just (noLocA (noLocA (IEVar Nothing (noLocA (IEName noExtField (noLocA dots)))) : exports') )} in [ignore "Use explicit module export list" (L s o) (noLoc r) []] where diff --git a/src/Hint/Extensions.hs b/src/Hint/Extensions.hs index f1cec6cc1..a8577ec02 100644 --- a/src/Hint/Extensions.hs +++ b/src/Hint/Extensions.hs @@ -274,6 +274,7 @@ import Refact.Types import Data.Set qualified as Set import Data.Map qualified as Map +import GHC.Data.FastString import GHC.Types.SrcLoc import GHC.Types.SourceText import GHC.Hs @@ -423,7 +424,7 @@ used EmptyCase = hasS f where f :: HsExpr GhcPs -> Bool f (HsCase _ _ (MG _ (L _ []))) = True - f (HsLamCase _ _ (MG _ (L _ []))) = True + f (HsLam _ LamCase (MG _ (L _ []))) = True f _ = False used KindSignatures = hasT (un :: HsKind GhcPs) used BangPatterns = hasS isPBangPat ||^ hasS isStrictMatch @@ -492,8 +493,8 @@ used MultiWayIf = hasS isMultiIf used NumericUnderscores = hasS f where f :: OverLitVal -> Bool - f (HsIntegral (IL (SourceText t) _ _)) = '_' `elem` t - f (HsFractional (FL (SourceText t) _ _ _ _)) = '_' `elem` t + f (HsIntegral (IL (SourceText t) _ _)) = '_' `elem` unpackFS t + f (HsFractional (FL (SourceText t) _ _ _ _)) = '_' `elem` unpackFS t f _ = False used LambdaCase = hasS isLCase diff --git a/src/Hint/Fixities.hs b/src/Hint/Fixities.hs index 165afb77f..4d723bf9c 100644 --- a/src/Hint/Fixities.hs +++ b/src/Hint/Fixities.hs @@ -73,7 +73,6 @@ needParenAsChild :: HsExpr p -> Bool needParenAsChild HsLet{} = True needParenAsChild HsDo{} = True needParenAsChild HsLam{} = True -needParenAsChild HsLamCase{} = True needParenAsChild HsCase{} = True needParenAsChild HsIf{} = True needParenAsChild _ = False diff --git a/src/Hint/Lambda.hs b/src/Hint/Lambda.hs index c0f9270d2..c8a2b50d2 100644 --- a/src/Hint/Lambda.hs +++ b/src/Hint/Lambda.hs @@ -170,7 +170,7 @@ lambdaBind where reform :: [LPat GhcPs] -> LHsExpr GhcPs -> Located (HsDecl GhcPs) reform ps b = L (combineSrcSpans (locA loc1) (locA loc2)) $ ValD noExtField $ - origBind {fun_matches = MG Generated (noLocA [noLocA $ Match EpAnnNotUsed ctxt ps $ GRHSs emptyComments [noLocA $ GRHS EpAnnNotUsed [] b] $ EmptyLocalBinds noExtField])} + origBind {fun_matches = MG (Generated DoPmc) (noLocA [noLocA $ Match EpAnnNotUsed ctxt ps $ GRHSs emptyComments [noLocA $ GRHS EpAnnNotUsed [] b] $ EmptyLocalBinds noExtField])} mkSubtsAndTpl newPats newBody = (sub, tpl) where @@ -213,7 +213,7 @@ lambdaExp _ o@(L _ (HsPar _ _ (view -> App2 (view -> Var_ "flip") origf@(view -> var = if rdrNameStr f == "x" then "y" else "x" r = Replace Expr (toSSA o) [(var, toSSA y)] ("(" ++ op ++ " " ++ var ++ ")") -lambdaExp p o@(L _ HsLam{}) +lambdaExp p o@(L _ (HsLam _ LamSingle _)) | not $ any isOpApp p , (res, refact) <- niceLambdaR [] o , not $ isLambda res @@ -280,11 +280,11 @@ lambdaExp _ o@(SimpleLambda [view -> PVar_ x] (L _ expr)) = | otherwise = [] needParens = any (patNeedsParens appPrec . unLoc) (m_pats oldmatch) in [ suggest "Use lambda" (reLoc o) - ( noLoc $ HsLam noExtField oldMG + ( noLoc $ HsLam EpAnnNotUsed LamSingle oldMG { mg_alts = noLocA [ noLocA oldmatch { m_pats = map mkParPat $ m_pats oldmatch - , m_ctxt = LambdaExpr + , m_ctxt = LamAlt LamSingle } ] } @@ -295,7 +295,7 @@ lambdaExp _ o@(SimpleLambda [view -> PVar_ x] (L _ expr)) = -- otherwise we should use @LambdaCase@ MG _ (L _ _) -> - [(suggestN "Use lambda-case" (reLoc o) $ noLoc $ HsLamCase EpAnnNotUsed LamCase matchGroup) + [(suggestN "Use lambda-case" (reLoc o) $ noLoc $ HsLam EpAnnNotUsed LamCase matchGroup) {ideaNote=[RequiresExtension "LambdaCase"]}] _ -> [] where diff --git a/src/Hint/ListRec.hs b/src/Hint/ListRec.hs index f3de15526..d3828e1cb 100644 --- a/src/Hint/ListRec.hs +++ b/src/Hint/ListRec.hs @@ -134,10 +134,10 @@ matchListRec o@(ListCase vs nil (x, xs, cons)) asDo :: LHsExpr GhcPs -> [LStmt GhcPs (LHsExpr GhcPs)] asDo (view -> App2 bind lhs - (L _ (HsLam _ MG { + (L _ (HsLam _ LamSingle MG { mg_ext=FromSource , mg_alts=L _ [ - L _ Match { m_ctxt=LambdaExpr + L _ Match { m_ctxt=(LamAlt LamSingle) , m_pats=[v@(L _ VarPat{})] , m_grhss=GRHSs _ [L _ (GRHS _ [] rhs)] @@ -176,7 +176,7 @@ findCase x = do gRHS e = noLocA $ GRHS EpAnnNotUsed [] e :: LGRHS GhcPs (LHsExpr GhcPs) -- Guarded rhs. gRHSSs e = GRHSs emptyComments [gRHS e] emptyLocalBinds -- Guarded rhs set. match e = Match{m_ext=EpAnnNotUsed,m_pats=ps12, m_grhss=gRHSSs e, ..} -- Match. - matchGroup e = MG{mg_alts=noLocA [noLocA $ match e], mg_ext=Generated, ..} -- Match group. + matchGroup e = MG{mg_alts=noLocA [noLocA $ match e], mg_ext=Generated DoPmc, ..} -- Match group. funBind e = FunBind {fun_matches=matchGroup e, ..} :: HsBindLR GhcPs GhcPs -- Fun bind. pure (ListCase ps b1 (x, xs, b2), noLocA . ValD noExtField . funBind) diff --git a/src/Hint/Monad.hs b/src/Hint/Monad.hs index 911ca4ad5..9aa365e5e 100644 --- a/src/Hint/Monad.hs +++ b/src/Hint/Monad.hs @@ -372,7 +372,7 @@ monadLet xs = mapMaybe mkLet xs grhs = noLocA (GRHS EpAnnNotUsed [] rhs) grhss = GRHSs emptyComments [grhs] (EmptyLocalBinds noExtField) match = noLocA $ Match EpAnnNotUsed (FunRhs p Prefix NoSrcStrict) [] grhss - fb = noLocA $ FunBind noExtField p (MG Generated (noLocA [match])) + fb = noLocA $ FunBind noExtField p (MG (Generated DoPmc) (noLocA [match])) binds = unitBag fb valBinds = ValBinds NoAnnSortKey binds [] localBinds = HsValBinds EpAnnNotUsed valBinds diff --git a/src/Hint/Naming.hs b/src/Hint/Naming.hs index fccfc295a..0d4f313ad 100644 --- a/src/Hint/Naming.hs +++ b/src/Hint/Naming.hs @@ -102,7 +102,7 @@ shortenLGRHS (L locGRHS (GRHS ttg0 guards (L locExpr _))) = L locGRHS (GRHS ttg0 guards (L locExpr dots)) where dots :: HsExpr GhcPs - dots = HsLit EpAnnNotUsed (HsString (SourceText "...") (mkFastString "...")) + dots = HsLit EpAnnNotUsed (HsString (SourceText (fsLit "...")) (fsLit "...")) getNames :: LHsDecl GhcPs -> [String] getNames decl = maybeToList (declName decl) ++ getConstructorNames (unLoc decl) diff --git a/src/Hint/Negation.hs b/src/Hint/Negation.hs index 6ef5031e3..880858263 100644 --- a/src/Hint/Negation.hs +++ b/src/Hint/Negation.hs @@ -45,7 +45,7 @@ negationParensHint _ _ x = negatedOp :: LHsExpr GhcPs -> [Idea] negatedOp e = case e of - L b1 (NegApp a1 inner@(L _ (OpApp {})) a2) -> + L b1 (NegApp a1 inner@(L _ OpApp {}) a2) -> pure $ rawIdea Suggestion diff --git a/src/Hint/NumLiteral.hs b/src/Hint/NumLiteral.hs index c740f76ac..51bf62f0a 100644 --- a/src/Hint/NumLiteral.hs +++ b/src/Hint/NumLiteral.hs @@ -22,6 +22,7 @@ module Hint.NumLiteral (numLiteralHint) where import GHC.Hs +import GHC.Data.FastString import GHC.LanguageExtensions.Type (Extension (..)) import GHC.Types.SrcLoc import GHC.Types.SourceText @@ -49,18 +50,18 @@ numLiteralHint _ modu = suggestUnderscore :: LHsExpr GhcPs -> [Idea] suggestUnderscore x@(L _ (HsOverLit _ ol@(OverLit _ (HsIntegral intLit@(IL (SourceText srcTxt) _ _))))) = - [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` srcTxt, srcTxt /= underscoredSrcTxt ] + [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` unpackFS srcTxt, unpackFS srcTxt /= underscoredSrcTxt ] where - underscoredSrcTxt = addUnderscore srcTxt - y :: LocatedAn an (HsExpr GhcPs) - y = noLocA $ HsOverLit EpAnnNotUsed $ ol{ol_val = HsIntegral intLit{il_text = SourceText underscoredSrcTxt}} + underscoredSrcTxt = addUnderscore (unpackFS srcTxt) + y :: LocatedAn NoEpAnns (HsExpr GhcPs) + y = noLocA $ HsOverLit EpAnnNotUsed $ ol{ol_val = HsIntegral intLit{il_text = SourceText (fsLit underscoredSrcTxt)}} r = Replace Expr (toSSA x) [("a", toSSA y)] "a" suggestUnderscore x@(L _ (HsOverLit _ ol@(OverLit _ (HsFractional fracLit@(FL (SourceText srcTxt) _ _ _ _))))) = - [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` srcTxt, srcTxt /= underscoredSrcTxt ] + [ suggest "Use underscore" (reLoc x) (reLoc y) [r] | '_' `notElem` unpackFS srcTxt, unpackFS srcTxt /= underscoredSrcTxt ] where - underscoredSrcTxt = addUnderscore srcTxt - y :: LocatedAn an (HsExpr GhcPs) - y = noLocA $ HsOverLit EpAnnNotUsed $ ol{ol_val = HsFractional fracLit{fl_text = SourceText underscoredSrcTxt}} + underscoredSrcTxt = addUnderscore (unpackFS srcTxt) + y :: LocatedAn NoEpAnns (HsExpr GhcPs) + y = noLocA $ HsOverLit EpAnnNotUsed $ ol{ol_val = HsFractional fracLit{fl_text = SourceText (fsLit underscoredSrcTxt)}} r = Replace Expr (toSSA x) [("a", toSSA y)] "a" suggestUnderscore _ = mempty diff --git a/src/Hint/Unsafe.hs b/src/Hint/Unsafe.hs index 642b65e89..1018b2de3 100644 --- a/src/Hint/Unsafe.hs +++ b/src/Hint/Unsafe.hs @@ -60,13 +60,15 @@ unsafeHint _ (ModuleEx (L _ m)) = \ld@(L loc d) -> -- 'x' is not marked 'NOINLINE'. , x `notElem` noinline] where + noInline = fsLit $ '{' : '-' : '#' : " NOINLINE" + gen :: OccName -> LHsDecl GhcPs gen x = noLocA $ SigD noExtField (InlineSig EpAnnNotUsed (noLocA (mkRdrUnqual x)) - (InlinePragma (SourceText "{-# NOINLINE") (NoInline (SourceText "{-# NOINLINE")) Nothing NeverActive FunLike)) + (InlinePragma (SourceText noInline) (NoInline (SourceText noInline)) Nothing NeverActive FunLike)) noinline :: [OccName] noinline = [q | L _(SigD _ (InlineSig _ (L _ (Unqual q)) - (InlinePragma _ (NoInline (SourceText "{-# NOINLINE")) Nothing NeverActive FunLike)) + (InlinePragma _ (NoInline (SourceText noInline)) Nothing NeverActive FunLike)) ) <- hsmodDecls m] isUnsafeDecl :: HsDecl GhcPs -> Bool