Remove ticks from FreeVars

ndmitchell · May 13, 2020 · 9d0748f · 9d0748f
1 parent 24749d2
commit 9d0748f
Show file tree

Hide file tree

Showing 7 changed files with 228 additions and 231 deletions.
diff --git a/src/GHC/Util/FreeVars.hs b/src/GHC/Util/FreeVars.hs
diff --git a/src/GHC/Util/HsExpr.hs b/src/GHC/Util/HsExpr.hs
@@ -122,7 +122,7 @@ simplifyExp' e@(L _ (HsLet _ (L _ (HsValBinds _ (ValBinds _ binds []))) z)) =
     [L _ (FunBind _ _(MG _ (L _ [L _ (Match _(FunRhs (L _ x) _ _) [] (GRHSs _[L _ (GRHS _ [] y)] (L _ (EmptyLocalBinds _))))]) _) _ _)]
          -- If 'x' is not in the free variables of 'y', beta-reduce to
          -- 'z[(y)/x]'.
-      | occNameString (rdrNameOcc x) `notElem` vars' y && length [() | Unqual a <- universeBi z, a == rdrNameOcc x] <= 1 ->
+      | occNameString (rdrNameOcc x) `notElem` vars y && length [() | Unqual a <- universeBi z, a == rdrNameOcc x] <= 1 ->
           transform f z
           where f (view -> Var_ x') | occNameString (rdrNameOcc x) == x' = paren' y
                 f x = x
@@ -162,23 +162,23 @@ niceLambdaR' xs (L _ (HsPar _ x)) = niceLambdaR' xs x
 niceLambdaR' (unsnoc -> Just (vs, v)) (view -> App2 f e (view -> Var_ v'))
   | isDol f
   , v == v'
-  , vars' e `disjoint` [v]
+  , vars e `disjoint` [v]
   = niceLambdaR' vs e
 
 -- @\v -> thing + v@ ==> @\v -> (thing +)@  (heuristic: @v@ must be a single
 -- lexeme, or it all gets too complex)
 niceLambdaR' [v] (L _ (OpApp _ e f (view -> Var_ v')))
   | isLexeme e
   , v == v'
-  , vars' e `disjoint` [v]
+  , vars e `disjoint` [v]
   , L _ (HsVar _ (L _ fname)) <- f
   , isSymOcc $ rdrNameOcc fname
   = (noLoc $ HsPar noExtField $ noLoc $ SectionL noExtField e f, \s -> [Replace Expr s [] (unsafePrettyPrint e)])
 
 -- @\vs v -> f x v@ ==> @\vs -> f x@
 niceLambdaR' (unsnoc -> Just (vs, v)) (L _ (HsApp _ f (view -> Var_ v')))
   | v == v'
-  , vars' f `disjoint` [v]
+  , vars f `disjoint` [v]
   = niceLambdaR' vs f
 
 -- @\vs v -> (v `f`)@ ==> @\vs -> f@
@@ -192,12 +192,12 @@ niceLambdaR' xs (SimpleLambda ((view -> PVar_ v):vs) x)
 -- Rewrite @\x -> x + a@ as @(+ a)@ (heuristic: @a@ must be a single
 -- lexeme, or it all gets too complex).
 niceLambdaR' [x] (view -> App2 op@(L _ (HsVar _ (L _ tag))) l r)
-  | isLexeme r, view l == Var_ x, x `notElem` vars' r, allowRightSection (occNameString $ rdrNameOcc tag) =
+  | isLexeme r, view l == Var_ x, x `notElem` vars r, allowRightSection (occNameString $ rdrNameOcc tag) =
       let e = rebracket1' $ addParen (noLoc $ SectionR noExtField op r)
       in (e, \s -> [Replace Expr s [] (unsafePrettyPrint e)])
 -- Rewrite (1) @\x -> f (b x)@ as @f . b@, (2) @\x -> f $ b x@ as @f . b@.
 niceLambdaR' [x] y
-  | Just (z, subts) <- factor y, x `notElem` vars' z = (z, \s -> [mkRefact subts s])
+  | Just (z, subts) <- factor y, x `notElem` vars z = (z, \s -> [mkRefact subts s])
   where
     -- Factor the expression with respect to x.
     factor :: LHsExpr GhcPs -> Maybe (LHsExpr GhcPs, [LHsExpr GhcPs])
@@ -217,10 +217,10 @@ niceLambdaR' [x] y
       in Replace Expr s tempSubts (unsafePrettyPrint template)
 -- Rewrite @\x y -> x + y@ as @(+)@.
 niceLambdaR' [x,y] (L _ (OpApp _ (view -> Var_ x1) op@(L _ HsVar {}) (view -> Var_ y1)))
-    | x == x1, y == y1, vars' op `disjoint` [x, y] = (op, \s -> [Replace Expr s [] (unsafePrettyPrint op)])
+    | x == x1, y == y1, vars op `disjoint` [x, y] = (op, \s -> [Replace Expr s [] (unsafePrettyPrint op)])
 -- Rewrite @\x y -> f y x@ as @flip f@.
 niceLambdaR' [x, y] (view -> App2 op (view -> Var_ y1) (view -> Var_ x1))
-  | x == x1, y == y1, vars' op `disjoint` [x, y] =
+  | x == x1, y == y1, vars op `disjoint` [x, y] =
       ( gen op
       , \s -> [Replace Expr s [("x", toSS op)] (unsafePrettyPrint $ gen (strToVar "x"))]
       )

diff --git a/src/Hint/Lambda.hs b/src/Hint/Lambda.hs
@@ -106,7 +106,7 @@ import Data.Generics.Uniplate.Operations (universe, universeBi, transformBi)
 
 import BasicTypes
 import GHC.Util.Brackets (isAtom)
-import GHC.Util.FreeVars (free', allVars', freeVars', pvars', vars', varss')
+import GHC.Util.FreeVars (free, allVars, freeVars, pvars, vars, varss)
 import GHC.Util.HsExpr (allowLeftSection, allowRightSection, niceLambdaR', lambda)
 import GHC.Util.RdrName (rdrNameStr')
 import GHC.Util.View
@@ -132,7 +132,7 @@ lambdaDecl
     , isLambda $ fromParen origBody
     , null (universeBi pats :: [HsExpr GhcPs])
     = [warn "Redundant lambda" o (gen pats origBody) [Replace Decl (toSS o) s1 t1]]
-    | length pats2 < length pats, pvars' (drop (length pats2) pats) `disjoint` varss' bind
+    | length pats2 < length pats, pvars (drop (length pats2) pats) `disjoint` varss bind
     = [warn "Eta reduce" (reform pats origBody) (reform pats2 bod2)
           [ -- Disabled, see apply-refact #3
             -- Replace Decl (toSS $ reform' pats origBody) s2 t2]]
@@ -161,7 +161,7 @@ lambdaDecl _ = []
 etaReduce :: [LPat GhcPs] -> LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs)
 etaReduce (unsnoc -> Just (ps, view -> PVar_ p)) (L _ (HsApp _ x (view -> Var_ y)))
     | p == y
-    , y `notElem` vars' x
+    , y `notElem` vars x
     , not $ any isQuasiQuote $ universe x
     = etaReduce ps x
 etaReduce ps (L loc (OpApp _ x (isDol -> True) y)) = etaReduce ps (L loc (HsApp noExtField x y))
@@ -184,7 +184,7 @@ lambdaExp p o@(L _ HsLam{})
     , (res, refact) <- niceLambdaR' [] o
     , not $ isLambda res
     , not $ any isQuasiQuote $ universe res
-    , not $ "runST" `Set.member` Set.map occNameString (freeVars' o)
+    , not $ "runST" `Set.member` Set.map occNameString (freeVars o)
     , let name = "Avoid lambda" ++ (if countRightSections res > countRightSections o then " using `infix`" else "")
     = [(if isVar res then warn else suggest) name o res (refact $ toSS o)]
     where
@@ -210,7 +210,7 @@ lambdaExp _ o@(SimpleLambda [view -> PVar_ x] (L _ expr)) =
             -- is there exactly one argument that is exactly x?
             | ([_x], ys) <- partition ((==Just x) . tupArgVar) args
             -- the other arguments must not have a nested x somewhere in them
-            , Set.notMember x $ Set.map occNameString $ freeVars' ys
+            , Set.notMember x $ Set.map occNameString $ freeVars ys
             -> [(suggestN "Use tuple-section" o $ noLoc $ ExplicitTuple noExtField (map removeX args) boxity)
                   {ideaNote = [RequiresExtension "TupleSections"]}]
 
@@ -219,7 +219,7 @@ lambdaExp _ o@(SimpleLambda [view -> PVar_ x] (L _ expr)) =
             -- is the case being done on the variable from our original lambda?
             | x == x'
             -- x must not be used in some other way inside the matches
-            , Set.notMember x $ Set.map occNameString $ free' $ allVars' matchGroup
+            , Set.notMember x $ Set.map occNameString $ free $ allVars matchGroup
             -> case matchGroup of
                  -- is there a single match? - suggest match inside the lambda
                  --
@@ -261,7 +261,7 @@ varBody = strToVar "body"
 
 -- | Squash lambdas and replace any repeated pattern variable with @_@
 fromLambda :: LHsExpr GhcPs -> ([LPat GhcPs], LHsExpr GhcPs)
-fromLambda (SimpleLambda ps1 (fromLambda . fromParen -> (ps2,x))) = (transformBi (f $ pvars' ps2) ps1 ++ ps2, x)
+fromLambda (SimpleLambda ps1 (fromLambda . fromParen -> (ps2,x))) = (transformBi (f $ pvars ps2) ps1 ++ ps2, x)
     where f :: [String] -> Pat GhcPs -> Pat GhcPs
           f bad (VarPat _ (rdrNameStr' -> x))
               | x `elem` bad = WildPat noExtField

diff --git a/src/Hint/List.hs b/src/Hint/List.hs
@@ -135,15 +135,13 @@ moveGuardsForward = reverse . f [] . reverse
                        || any isPFieldWildcard (universeBi x)
                       then const False
                       else \x ->
-                       let pvars = pvars' p
-                           vars = varss' x
-                        in
+                       let pvs = pvars p in
                        -- See this code from 'RdrHsSyn.hs' (8.10.1):
                        --   plus_RDR, pun_RDR :: RdrName
                        --   plus_RDR = mkUnqual varName (fsLit "+") -- Hack
                        --   pun_RDR  = mkUnqual varName (fsLit "pun-right-hand-side")
                        -- Todo (SF, 2020-03-28): Try to make this better somehow.
-                       pvars `disjoint` vars && "pun-right-hand-side" `notElem` pvars
+                       pvs `disjoint` varss x && "pun-right-hand-side" `notElem` pvs
                    ) guards
     f guards (x@(L _ BodyStmt{}):xs) = f (x:guards) xs
     f guards (x@(L _ LetStmt{}):xs) = f (x:guards) xs

diff --git a/src/Hint/ListRec.hs b/src/Hint/ListRec.hs
@@ -66,7 +66,7 @@ listRecHint _ _ = concatMap f . universe
             (x, addCase) <- findCase x
             (use,severity,x) <- matchListRec x
             let y = addCase x
-            guard $ recursiveStr `notElem` varss' y
+            guard $ recursiveStr `notElem` varss y
             -- Maybe we can do better here maintaining source
             -- formatting?
             pure $ idea severity ("Use " ++ use) o y [Replace Decl (toSS o) [] (unsafePrettyPrint y)]
@@ -102,25 +102,25 @@ matchListRec :: ListCase -> Maybe (String, Severity, LHsExpr GhcPs)
 matchListRec o@(ListCase vs nil (x, xs, cons))
     -- Suggest 'map'?
     | [] <- vs, varToStr nil == "[]", (L _ (OpApp _ lhs c rhs)) <- cons, varToStr c == ":"
-    , astEq (fromParen rhs) recursive, xs `notElem` vars' lhs
+    , astEq (fromParen rhs) recursive, xs `notElem` vars lhs
     = Just $ (,,) "map" Hint.Type.Warning $
       appsBracket' [ strToVar "map", niceLambda' [x] lhs, strToVar xs]
     -- Suggest 'foldr'?
     | [] <- vs, App2 op lhs rhs <- view cons
-    , xs `notElem` (vars' op ++ vars' lhs) -- the meaning of xs changes, see #793
+    , xs `notElem` (vars op ++ vars lhs) -- the meaning of xs changes, see #793
     , astEq (fromParen rhs) recursive
     = Just $ (,,) "foldr" Suggestion $
       appsBracket' [ strToVar "foldr", niceLambda' [x] $ appsBracket' [op,lhs], nil, strToVar xs]
     -- Suggest 'foldl'?
     | [v] <- vs, view nil == Var_ v, (L _ (HsApp _ r lhs)) <- cons
     , astEq (fromParen r) recursive
-    , xs `notElem` vars' lhs
+    , xs `notElem` vars lhs
     = Just $ (,,) "foldl" Suggestion $
       appsBracket' [ strToVar "foldl", niceLambda' [v,x] lhs, strToVar v, strToVar xs]
     -- Suggest 'foldM'?
     | [v] <- vs, (L _ (HsApp _ ret res)) <- nil, isReturn ret, varToStr res == "()" || view res == Var_ v
     , [L _ (BindStmt _ (view -> PVar_ b1) e _ _), L _ (BodyStmt _ (fromParen -> (L _ (HsApp _ r (view -> Var_ b2)))) _ _)] <- asDo cons
-    , b1 == b2, astEq r recursive, xs `notElem` vars' e
+    , b1 == b2, astEq r recursive, xs `notElem` vars e
     , name <- "foldM" ++ ['_' | varToStr res == "()"]
     = Just $ (,,) name Suggestion $
       appsBracket' [strToVar name, niceLambda' [v,x] e, strToVar v, strToVar xs]

diff --git a/src/Hint/Match.hs b/src/Hint/Match.hs
@@ -77,7 +77,7 @@ readRule' m@HintRule{ hintRuleLHS=(stripLocs' . unextendInstances -> hintRuleLHS
     (l, v1) <- dotVersion' hintRuleLHS
     (r, v2) <- dotVersion' hintRuleRHS
 
-    guard $ v1 == v2 && not (null l) && (length l > 1 || length r > 1) && Set.notMember v1 (Set.map occNameString (freeVars' $ maybeToList hintRuleSide ++ l ++ r))
+    guard $ v1 == v2 && not (null l) && (length l > 1 || length r > 1) && Set.notMember v1 (Set.map occNameString (freeVars $ maybeToList hintRuleSide ++ l ++ r))
     if not (null r) then
       [ m{ hintRuleLHS=extendInstances (dotApps' l), hintRuleRHS=extendInstances (dotApps' r), hintRuleSide=extendInstances <$> hintRuleSide }
       , m{ hintRuleLHS=extendInstances (dotApps' (l ++ [strToVar v1])), hintRuleRHS=extendInstances (dotApps' (r ++ [strToVar v1])), hintRuleSide=extendInstances <$> hintRuleSide } ]
@@ -146,7 +146,7 @@ matchIdea sb declName HintRule{..} parent x = do
   u <- pure (removeParens noParens u)
 
   let res = addBracketTy' (addBracket' parent $ performSpecial' $ fst $ substitute' u $ unqualify' sa sb rhs')
-  guard $ (freeVars' e Set.\\ Set.filter (not . isUnifyVar . occNameString) (freeVars' rhs')) `Set.isSubsetOf` freeVars' x
+  guard $ (freeVars e Set.\\ Set.filter (not . isUnifyVar . occNameString) (freeVars rhs')) `Set.isSubsetOf` freeVars x
       -- Check no unexpected new free variables.
 
   -- Check it isn't going to get broken by QuasiQuotes as per #483. If

diff --git a/src/Hint/Monad.hs b/src/Hint/Monad.hs
@@ -191,7 +191,7 @@ monadStep wrap o@[ g@(L _ (BindStmt _ (LL _ (VarPat _ (L _ p))) x _ _ ))
 
 -- Suggest to use join. Rewrite 'do x <- $1; x; $2' as 'do join $1; $2'.
 monadStep wrap o@(g@(L _ (BindStmt _ (view -> PVar_ p) x _ _)):q@(L _ (BodyStmt _ (view -> Var_ v) _ _)):xs)
-  | p == v && v `notElem` varss' xs
+  | p == v && v `notElem` varss xs
   = let app = noLoc $ HsApp noExtField (strToVar "join") x
         body = noLoc $ BodyStmt noExtField (rebracket1' app) noSyntaxExpr noSyntaxExpr
         stmts = body : xs
@@ -216,7 +216,7 @@ monadStep
 monadStep wrap
   o@[g@(L _ (BindStmt _ (view -> PVar_ u) x _ _))
     , q@(L _ (BodyStmt _ (fromApplies -> (ret:f:fs, view -> Var_ v)) _ _))]
-  | isReturn ret, notDol x, u == v, length fs < 3, all isSimple (f : fs), v `notElem` vars' (f : fs)
+  | isReturn ret, notDol x, u == v, length fs < 3, all isSimple (f : fs), v `notElem` vars (f : fs)
   =
       [warn "Use <$>" (wrap o) (wrap [noLoc $ BodyStmt noExtField (noLoc $ OpApp noExtField (foldl' (\acc e -> noLoc $ OpApp noExtField acc (strToVar ".") e) f fs) (strToVar "<$>") x) noSyntaxExpr noSyntaxExpr])
       [Replace Stmt (toSS g) (("x", toSS x):zip vs (toSS <$> f:fs)) (intercalate " . " (take (length fs + 1) vs) ++ " <$> x"), Delete Stmt (toSS q)]]
@@ -239,11 +239,11 @@ monadSteps _ _ = []
 monadLet :: [ExprLStmt GhcPs] -> [(ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring R.SrcSpan)]
 monadLet xs = mapMaybe mkLet xs
   where
-    vs = concatMap pvars' [p | (L _ (BindStmt _ p _ _ _)) <- xs]
+    vs = concatMap pvars [p | (L _ (BindStmt _ p _ _ _)) <- xs]
 
     mkLet :: ExprLStmt GhcPs -> Maybe (ExprLStmt GhcPs, ExprLStmt GhcPs, Refactoring R.SrcSpan)
     mkLet x@(L _ (BindStmt _ v@(view -> PVar_ p) (fromRet -> Just (_, y)) _ _ ))
-      | p `notElem` vars' y, p `notElem` delete p vs
+      | p `notElem` vars y, p `notElem` delete p vs
       = Just (x, template p y, refact)
       where
         refact = Replace Stmt (toSS x) [("lhs", toSS v), ("rhs", toSS y)]