Remove support for _eval_

ndmitchell · Mar 28, 2020 · a0f5c65 · a0f5c65
1 parent abee2c7
commit a0f5c65
Show file tree

Hide file tree

Showing 5 changed files with 5 additions and 28 deletions.
diff --git a/CHANGES.txt b/CHANGES.txt
@@ -1,5 +1,6 @@
 Changelog for HLint (* = breaking change)
 
+    Remove support for _eval,
     #926, fix refactoring when the hint contains _noParen_
     #933, improve the output for Redundant do hints
 *   Merge ParseMode into ParseFlags

diff --git a/data/HLint_QuickCheck.hs b/data/HLint_QuickCheck.hs
@@ -102,7 +102,6 @@ catcher x = unsafePerformIO $ do
         Right v -> Just v
 
 _noParen_ = id
-_eval_ = id
 
 withMain :: IO () -> IO ()
 withMain act = do

diff --git a/data/HLint_TypeCheck.hs b/data/HLint_TypeCheck.hs
@@ -6,7 +6,6 @@ module HLint_TypeCheck where
 (==>) = undefined
 
 _noParen_ = id
-_eval_ = id
 
 
 ---------------------------------------------------------------------

diff --git a/src/GHC/Util/HsExpr.hs b/src/GHC/Util/HsExpr.hs
@@ -9,7 +9,7 @@ module GHC.Util.HsExpr (
   , rebracket1', appsBracket', transformAppsM', fromApps', apps', universeApps', universeParentExp'
   , paren'
   , replaceBranches'
-  , needBracketOld', transformBracketOld', reduce', fromParen1'
+  , needBracketOld', transformBracketOld', fromParen1'
   , allowLeftSection, allowRightSection
 ) where
 
@@ -298,25 +298,6 @@ descendBracketOld' op x = (descendIndex' g1 x, descendIndex' g2 x)
 
     ifNoLocElse y z = if getLoc y == noSrcSpan then y else z
 
-reduce' :: LHsExpr GhcPs -> LHsExpr GhcPs
-reduce' = fromParen' . transform reduce1'
-
-reduce1' :: LHsExpr GhcPs -> LHsExpr GhcPs
-reduce1' (L loc (HsApp _ len (L _ (HsLit _ (HsString _ xs)))))
-  | varToStr len == "length" = cL loc $ HsLit noExt (HsInt noExt (IL NoSourceText False n))
-  where n = fromIntegral $ length (unpackFS xs)
-reduce1' (L loc (HsApp _ len (L _ (ExplicitList _ _ xs))))
-  | varToStr len == "length" = cL loc $ HsLit noExt (HsInt noExt (IL NoSourceText False n))
-  where n = fromIntegral $ length xs
-reduce1' (view' -> App2' op (L _ (HsLit _ x)) (L _ (HsLit _ y))) | varToStr op == "==" = strToVar (show (astEq x y))
-reduce1' (view' -> App2' op (L _ (HsLit _ (HsInt _ x))) (L _ (HsLit _ (HsInt _ y)))) | varToStr op == ">=" = strToVar $ show (x >= y)
-reduce1' (view' -> App2' op x y)
-    | varToStr op == "&&" && varToStr x == "True"  = y
-    | varToStr op == "&&" && varToStr x == "False" = x
-reduce1' (L _ (HsPar _ x)) | isAtom' x = x
-reduce1' x = x
-
-
 fromParen1' :: LHsExpr GhcPs -> LHsExpr GhcPs
 fromParen1' (L _ (HsPar _ x)) = x
 fromParen1' x = x
diff --git a/src/Hint/Match.hs b/src/Hint/Match.hs
@@ -8,7 +8,6 @@ we substitute, transform and check the side conditions. We also "see through"
 both ($) and (.) functions on the right.
 
 TRANSFORM PATTERNS
-_eval_ - perform deep evaluation, must be used at the top of a RHS
 _noParen_ - don't bracket this particular item
 
 SIDE CONDITIONS
@@ -238,13 +237,11 @@ checkDefine' _ _ _ = True
 ---------------------------------------------------------------------
 -- TRANSFORMATION
 
--- If it has '_eval_' do evaluation on it. If it has '_noParen_', remove the brackets (if exist).
+-- If it has '_noParen_', remove the brackets (if exist).
 performSpecial' :: LHsExpr GhcPs -> LHsExpr GhcPs
-performSpecial' = transform fNoParen . fEval
+performSpecial' = transform fNoParen
   where
-    fEval, fNoParen :: LHsExpr GhcPs -> LHsExpr GhcPs
-    fEval (L _ (HsApp _ e x)) | varToStr e == "_eval_" = reduce' x
-    fEval x = x
+    fNoParen :: LHsExpr GhcPs -> LHsExpr GhcPs
     fNoParen (L _ (HsApp _ e x)) | varToStr e == "_noParen_" = fromParen' x
     fNoParen x = x
-Original file line number
+Diff line change
@@ Expand Up / @@ -6,7 +6,6 @@ module HLint_TypeCheck where @@
     (==>) = undefined
     _noParen_ = id
-    _eval_ = id
     ---------------------------------------------------------------------
@@ Expand Down @@