Improve Fix memory usage

This commit is contained in:
Vidar Holen 2018-10-22 19:39:24 -07:00
parent a8376a09a9
commit bcd13614eb
4 changed files with 45 additions and 31 deletions

View File

@ -55,6 +55,7 @@ library
base > 4.6.0.1 && < 5, base > 4.6.0.1 && < 5,
bytestring, bytestring,
containers >= 0.5, containers >= 0.5,
deepseq >= 1.4.0.0,
directory, directory,
mtl >= 2.2.1, mtl >= 2.2.1,
parsec, parsec,
@ -91,6 +92,7 @@ executable shellcheck
aeson, aeson,
base >= 4 && < 5, base >= 4 && < 5,
bytestring, bytestring,
deepseq >= 1.4.0.0,
ShellCheck, ShellCheck,
containers, containers,
directory, directory,
@ -106,6 +108,7 @@ test-suite test-shellcheck
aeson, aeson,
base >= 4 && < 5, base >= 4 && < 5,
bytestring, bytestring,
deepseq >= 1.4.0.0,
ShellCheck, ShellCheck,
containers, containers,
directory, directory,

View File

@ -17,14 +17,17 @@
You should have received a copy of the GNU General Public License You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>. along with this program. If not, see <https://www.gnu.org/licenses/>.
-} -}
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
module ShellCheck.AST where module ShellCheck.AST where
import GHC.Generics (Generic)
import Control.Monad.Identity import Control.Monad.Identity
import Control.DeepSeq
import Text.Parsec import Text.Parsec
import qualified ShellCheck.Regex as Re import qualified ShellCheck.Regex as Re
import Prelude hiding (id) 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 Quoted = Quoted | Unquoted deriving (Show, Eq)
data Dashed = Dashed | Undashed deriving (Show, Eq) data Dashed = Dashed | Undashed deriving (Show, Eq)

View File

@ -20,26 +20,28 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
module ShellCheck.AnalyzerLib where 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 ShellCheck.AST
import Control.Monad.Identity import ShellCheck.ASTLib
import Control.Monad.RWS import ShellCheck.Data
import Control.Monad.State import ShellCheck.Interface
import Control.Monad.Writer import ShellCheck.Parser
import Data.Char import ShellCheck.Regex
import Data.List
import qualified Data.Map as Map
import Data.Maybe
import Data.Semigroup
import Test.QuickCheck.All (forAllProperties) import Control.Arrow (first)
import Test.QuickCheck.Test (maxSuccess, quickCheckWithResult, stdArgs) 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 Analysis = AnalyzerM ()
type AnalyzerM a = RWS Parameters [TokenComment] Cache a 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 :: MonadWriter [TokenComment] m => Id -> Code -> String -> m ()
warn id code str = addComment $ makeComment WarningC id code str 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 -> String -> Fix -> TokenComment
makeCommentWithFix severity id code str fix = makeCommentWithFix severity id code str fix =
let comment = makeComment severity id code str in let comment = makeComment severity id code str
comment { withFix = comment {
tcFix = Just fix tcFix = Just fix
} }
in withFix `deepseq` withFix
makeParameters spec = makeParameters spec =
let params = Parameters { let params = Parameters {

View File

@ -17,6 +17,7 @@
You should have received a copy of the GNU General Public License You should have received a copy of the GNU General Public License
along with this program. If not, see <https://www.gnu.org/licenses/>. along with this program. If not, see <https://www.gnu.org/licenses/>.
-} -}
{-# LANGUAGE DeriveGeneric, DeriveAnyClass #-}
module ShellCheck.Interface module ShellCheck.Interface
( (
SystemInterface(..) SystemInterface(..)
@ -56,8 +57,11 @@ module ShellCheck.Interface
) where ) where
import ShellCheck.AST import ShellCheck.AST
import Control.DeepSeq
import Control.Monad.Identity import Control.Monad.Identity
import Data.Monoid import Data.Monoid
import GHC.Generics (Generic)
import qualified Data.Map as Map import qualified Data.Map as Map
@ -170,12 +174,13 @@ data ExecutionMode = Executed | Sourced deriving (Show, Eq)
type ErrorMessage = String type ErrorMessage = String
type Code = Integer 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 { data Position = Position {
posFile :: String, -- Filename posFile :: String, -- Filename
posLine :: Integer, -- 1 based source line posLine :: Integer, -- 1 based source line
posColumn :: Integer -- 1 based source column, where tabs are 8 posColumn :: Integer -- 1 based source column, where tabs are 8
} deriving (Show, Eq) } deriving (Show, Eq, Generic, NFData)
newPosition :: Position newPosition :: Position
newPosition = Position { newPosition = Position {
@ -188,7 +193,7 @@ data Comment = Comment {
cSeverity :: Severity, cSeverity :: Severity,
cCode :: Code, cCode :: Code,
cMessage :: String cMessage :: String
} deriving (Show, Eq) } deriving (Show, Eq, Generic, NFData)
newComment :: Comment newComment :: Comment
newComment = Comment { newComment = Comment {
@ -202,7 +207,7 @@ data Replacement = Replacement {
repStartPos :: Position, repStartPos :: Position,
repEndPos :: Position, repEndPos :: Position,
repString :: String repString :: String
} deriving (Show, Eq) } deriving (Show, Eq, Generic, NFData)
newReplacement = Replacement { newReplacement = Replacement {
repStartPos = newPosition, repStartPos = newPosition,
@ -212,7 +217,7 @@ newReplacement = Replacement {
data Fix = Fix { data Fix = Fix {
fixReplacements :: [Replacement] fixReplacements :: [Replacement]
} deriving (Show, Eq) } deriving (Show, Eq, Generic, NFData)
newFix = Fix { newFix = Fix {
fixReplacements = [] fixReplacements = []
@ -223,7 +228,7 @@ data PositionedComment = PositionedComment {
pcEndPos :: Position, pcEndPos :: Position,
pcComment :: Comment, pcComment :: Comment,
pcFix :: Maybe Fix pcFix :: Maybe Fix
} deriving (Show, Eq) } deriving (Show, Eq, Generic, NFData)
newPositionedComment :: PositionedComment newPositionedComment :: PositionedComment
newPositionedComment = PositionedComment { newPositionedComment = PositionedComment {
@ -237,7 +242,7 @@ data TokenComment = TokenComment {
tcId :: Id, tcId :: Id,
tcComment :: Comment, tcComment :: Comment,
tcFix :: Maybe Fix tcFix :: Maybe Fix
} deriving (Show, Eq) } deriving (Show, Eq, Generic, NFData)
newTokenComment = TokenComment { newTokenComment = TokenComment {
tcId = Id 0, tcId = Id 0,