From bcd13614ebf026774fb5c2e9ae47236648704aac Mon Sep 17 00:00:00 2001 From: Vidar Holen Date: Mon, 22 Oct 2018 19:39:24 -0700 Subject: [PATCH] Improve Fix memory usage --- ShellCheck.cabal | 3 +++ src/ShellCheck/AST.hs | 5 +++- src/ShellCheck/AnalyzerLib.hs | 49 +++++++++++++++++++---------------- src/ShellCheck/Interface.hs | 19 +++++++++----- 4 files changed, 45 insertions(+), 31 deletions(-) diff --git a/ShellCheck.cabal b/ShellCheck.cabal index 8a46661..721da3f 100644 --- a/ShellCheck.cabal +++ b/ShellCheck.cabal @@ -55,6 +55,7 @@ library base > 4.6.0.1 && < 5, bytestring, containers >= 0.5, + deepseq >= 1.4.0.0, directory, mtl >= 2.2.1, parsec, @@ -91,6 +92,7 @@ executable shellcheck aeson, base >= 4 && < 5, bytestring, + deepseq >= 1.4.0.0, ShellCheck, containers, directory, @@ -106,6 +108,7 @@ test-suite test-shellcheck aeson, base >= 4 && < 5, bytestring, + deepseq >= 1.4.0.0, ShellCheck, containers, directory, diff --git a/src/ShellCheck/AST.hs b/src/ShellCheck/AST.hs index cd96165..8a6d7b2 100644 --- a/src/ShellCheck/AST.hs +++ b/src/ShellCheck/AST.hs @@ -17,14 +17,17 @@ You should have received a copy of the GNU General Public License along with this program. If not, see . -} +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} module ShellCheck.AST where +import GHC.Generics (Generic) import Control.Monad.Identity +import Control.DeepSeq import Text.Parsec import qualified ShellCheck.Regex as Re import Prelude hiding (id) -newtype Id = Id Int deriving (Show, Eq, Ord) +newtype Id = Id Int deriving (Show, Eq, Ord, Generic, NFData) data Quoted = Quoted | Unquoted deriving (Show, Eq) data Dashed = Dashed | Undashed deriving (Show, Eq) diff --git a/src/ShellCheck/AnalyzerLib.hs b/src/ShellCheck/AnalyzerLib.hs index 1639ff6..9b7892d 100644 --- a/src/ShellCheck/AnalyzerLib.hs +++ b/src/ShellCheck/AnalyzerLib.hs @@ -20,26 +20,28 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TemplateHaskell #-} module ShellCheck.AnalyzerLib where -import ShellCheck.AST -import ShellCheck.ASTLib -import ShellCheck.Data -import ShellCheck.Interface -import ShellCheck.Parser -import ShellCheck.Regex -import Control.Arrow (first) -import Control.Monad.Identity -import Control.Monad.RWS -import Control.Monad.State -import Control.Monad.Writer -import Data.Char -import Data.List -import qualified Data.Map as Map -import Data.Maybe -import Data.Semigroup +import ShellCheck.AST +import ShellCheck.ASTLib +import ShellCheck.Data +import ShellCheck.Interface +import ShellCheck.Parser +import ShellCheck.Regex -import Test.QuickCheck.All (forAllProperties) -import Test.QuickCheck.Test (maxSuccess, quickCheckWithResult, stdArgs) +import Control.Arrow (first) +import Control.DeepSeq +import Control.Monad.Identity +import Control.Monad.RWS +import Control.Monad.State +import Control.Monad.Writer +import Data.Char +import Data.List +import Data.Maybe +import Data.Semigroup +import qualified Data.Map as Map + +import Test.QuickCheck.All (forAllProperties) +import Test.QuickCheck.Test (maxSuccess, quickCheckWithResult, stdArgs) type Analysis = AnalyzerM () type AnalyzerM a = RWS Parameters [TokenComment] Cache a @@ -143,7 +145,7 @@ makeComment severity id code note = } } -addComment note = tell [note] +addComment note = note `deepseq` tell [note] warn :: MonadWriter [TokenComment] m => Id -> Code -> String -> m () warn id code str = addComment $ makeComment WarningC id code str @@ -159,10 +161,11 @@ warnWithFix id code str fix = addComment $ makeCommentWithFix :: Severity -> Id -> Code -> String -> Fix -> TokenComment makeCommentWithFix severity id code str fix = - let comment = makeComment severity id code str in - comment { - tcFix = Just fix - } + let comment = makeComment severity id code str + withFix = comment { + tcFix = Just fix + } + in withFix `deepseq` withFix makeParameters spec = let params = Parameters { diff --git a/src/ShellCheck/Interface.hs b/src/ShellCheck/Interface.hs index 4a7214b..092b9e8 100644 --- a/src/ShellCheck/Interface.hs +++ b/src/ShellCheck/Interface.hs @@ -17,6 +17,7 @@ You should have received a copy of the GNU General Public License along with this program. If not, see . -} +{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-} module ShellCheck.Interface ( SystemInterface(..) @@ -56,8 +57,11 @@ module ShellCheck.Interface ) where import ShellCheck.AST + +import Control.DeepSeq import Control.Monad.Identity import Data.Monoid +import GHC.Generics (Generic) import qualified Data.Map as Map @@ -170,12 +174,13 @@ data ExecutionMode = Executed | Sourced deriving (Show, Eq) type ErrorMessage = String type Code = Integer -data Severity = ErrorC | WarningC | InfoC | StyleC deriving (Show, Eq, Ord) +data Severity = ErrorC | WarningC | InfoC | StyleC + deriving (Show, Eq, Ord, Generic, NFData) data Position = Position { posFile :: String, -- Filename posLine :: Integer, -- 1 based source line posColumn :: Integer -- 1 based source column, where tabs are 8 -} deriving (Show, Eq) +} deriving (Show, Eq, Generic, NFData) newPosition :: Position newPosition = Position { @@ -188,7 +193,7 @@ data Comment = Comment { cSeverity :: Severity, cCode :: Code, cMessage :: String -} deriving (Show, Eq) +} deriving (Show, Eq, Generic, NFData) newComment :: Comment newComment = Comment { @@ -202,7 +207,7 @@ data Replacement = Replacement { repStartPos :: Position, repEndPos :: Position, repString :: String -} deriving (Show, Eq) +} deriving (Show, Eq, Generic, NFData) newReplacement = Replacement { repStartPos = newPosition, @@ -212,7 +217,7 @@ newReplacement = Replacement { data Fix = Fix { fixReplacements :: [Replacement] -} deriving (Show, Eq) +} deriving (Show, Eq, Generic, NFData) newFix = Fix { fixReplacements = [] @@ -223,7 +228,7 @@ data PositionedComment = PositionedComment { pcEndPos :: Position, pcComment :: Comment, pcFix :: Maybe Fix -} deriving (Show, Eq) +} deriving (Show, Eq, Generic, NFData) newPositionedComment :: PositionedComment newPositionedComment = PositionedComment { @@ -237,7 +242,7 @@ data TokenComment = TokenComment { tcId :: Id, tcComment :: Comment, tcFix :: Maybe Fix -} deriving (Show, Eq) +} deriving (Show, Eq, Generic, NFData) newTokenComment = TokenComment { tcId = Id 0,