cgrep 6.5.7 → 6.5.8
raw patch · 20 files changed
+957/−974 lines, 20 files
Files
- README.md +1/−1
- cgrep.cabal +2/−2
- src/CGrep/CGrep.hs +13/−12
- src/CGrep/Common.hs +6/−5
- src/CGrep/Parser/Cpp/Token.hs +381/−0
- src/CGrep/Parser/Generic/Token.hs +213/−0
- src/CGrep/Parser/Token.hs +32/−0
- src/CGrep/Parser/WildCard.hs +220/−0
- src/CGrep/Semantic/Cpp/Token.hs +0/−381
- src/CGrep/Semantic/Generic/Token.hs +0/−213
- src/CGrep/Semantic/Token.hs +0/−32
- src/CGrep/Semantic/WildCard.hs +0/−220
- src/CGrep/Strategy/BoyerMoore.hs +12/−18
- src/CGrep/Strategy/Cpp/Semantic.hs +29/−33
- src/CGrep/Strategy/Cpp/Tokenizer.hs +11/−15
- src/CGrep/Strategy/Generic/Semantic.hs +7/−8
- src/CGrep/Strategy/Levenshtein.hs +11/−11
- src/CGrep/Strategy/Regex.hs +7/−13
- src/Config.hs +11/−9
- src/Main.hs +1/−1
README.md view
@@ -4,7 +4,7 @@ Usage ----- -Cgrep 6.5.7 Usage: cgrep [OPTION] [PATTERN] files...+Cgrep 6.5.8 Usage: cgrep [OPTION] [PATTERN] files... cgrep [OPTIONS] [ITEM]
cgrep.cabal view
@@ -1,6 +1,6 @@ Name: cgrep Description: Cgrep: a context-aware grep for source codes-Version: 6.5.7+Version: 6.5.8 Synopsis: Command line tool Homepage: http://awgn.github.io/cgrep/ License: GPL-2@@ -25,7 +25,7 @@ BangPatterns, FlexibleInstances, FlexibleContexts- Other-Modules: Debug Options CmdOptions Util Config CGrep.Lang CGrep.Filter CGrep.Token CGrep.Types CGrep.CGrep CGrep.Output CGrep.Distance CGrep.Common CGrep.Context CGrep.Semantic.WildCard CGrep.Semantic.Generic.Token CGrep.Semantic.Token CGrep.Semantic.Cpp.Token CGrep.Strategy.Generic.Semantic CGrep.Strategy.Levenshtein CGrep.Strategy.BoyerMoore CGrep.Strategy.Cpp.Tokenizer CGrep.Strategy.Cpp.Semantic CGrep.Strategy.Regex+ Other-Modules: Debug Options CmdOptions Util Config CGrep.Lang CGrep.Filter CGrep.Token CGrep.Types CGrep.CGrep CGrep.Output CGrep.Distance CGrep.Common CGrep.Context CGrep.Parser.WildCard CGrep.Parser.Generic.Token CGrep.Parser.Token CGrep.Parser.Cpp.Token CGrep.Strategy.Generic.Semantic CGrep.Strategy.Levenshtein CGrep.Strategy.BoyerMoore CGrep.Strategy.Cpp.Tokenizer CGrep.Strategy.Cpp.Semantic CGrep.Strategy.Regex Build-Depends: base < 5.0, cmdargs >=0.10, bytestring >=0.10,
src/CGrep/CGrep.hs view
@@ -16,7 +16,7 @@ -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. -- -module CGrep.CGrep (sanitizeOptions, cgrepDispatch) where+module CGrep.CGrep (sanitizeOptions, runCgrep) where import qualified CGrep.Strategy.BoyerMoore as BoyerMoore import qualified CGrep.Strategy.Levenshtein as Levenshtein@@ -56,19 +56,20 @@ hasTokenizerOpt :: Options -> Bool hasTokenizerOpt Options- { identifier = i- , keyword = k- , directive = d- , header = h- , number = n- , string = s- , char = c- , oper = o- } = i || k || d || h || n || s || c || o+ { identifier = i+ , keyword = k+ , directive = d+ , header = h+ , number = n+ , string = s+ , char = c+ , oper = o+ } = i || k || d || h || n || s || c || o -cgrepDispatch :: FilePath -> [Text8] -> ReaderT Options IO [Output]-cgrepDispatch filename patterns = do++runCgrep :: FilePath -> [Text8] -> ReaderT Options IO [Output]+runCgrep filename patterns = do opt <- ask case () of _ | not (regex opt) && not (hasTokenizerOpt opt) && not (semantic opt) && edit_dist opt -> Levenshtein.search filename patterns
src/CGrep/Common.hs view
@@ -20,13 +20,14 @@ getTargetName, getTargetContents, quickSearch,- runSearch,+ runQuickSearch, expandMultiline, ignoreCase, trim, trim8) where import qualified Data.ByteString.Char8 as C import qualified Data.ByteString.Search as SC+ import Data.Char import Control.Monad.Trans.Reader@@ -62,11 +63,11 @@ where has_pattern pat = notNull $ pat `SC.nonOverlappingIndices` text -runSearch :: FilePath+runQuickSearch :: FilePath -> Maybe Bool -- quicksearch -> ReaderT Options IO [Output] -> ReaderT Options IO [Output]-runSearch filename quick doSearch =+runQuickSearch filename quick doSearch = if maybe False not quick then mkOutput filename C.empty C.empty [] else doSearch@@ -79,7 +80,7 @@ ignoreCase :: Options -> Text8 -> Text8-ignoreCase Options { ignore_case = icase }- | icase = C.map toLowercase+ignoreCase opt+ | ignore_case opt = C.map toLowercase | otherwise = id
+ src/CGrep/Parser/Cpp/Token.hs view
@@ -0,0 +1,381 @@+--+-- Copyright (c) 2012-2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++{-# LANGUAGE ViewPatterns #-}++module CGrep.Parser.Cpp.Token(Token(..), TokenFilter(..),+ Offset, tokenizer, tokenFilter, tokenCompare,+ isIdentifier, isKeyword, isDirective, isLiteralNumber,+ isHeaderName, isString, isChar, isOperOrPunct+ ) where++import Data.Char+import Data.Maybe+import Control.Monad+import Data.Array.Unboxed++import qualified Data.HashSet as HS+import qualified Data.HashMap.Strict as HM+import qualified Data.ByteString.Char8 as C++import CGrep.Parser.Token++data TokenizerState = TokenizerState Source {-# UNPACK #-} !Offset !CppState+type Source = C.ByteString+type Offset = Int+++data Token =+ TokenIdentifier { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |+ TokenDirective { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |+ TokenKeyword { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |+ TokenNumber { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |+ TokenHeaderName { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |+ TokenString { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |+ TokenChar { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |+ TokenOperOrPunct { toString :: !String, toOffset :: {-# UNPACK #-} !Int }+ deriving (Show, Eq, Ord)+++data TokenFilter = TokenFilter+ { filtIdentifier :: !Bool+ , filtDirective :: !Bool+ , filtKeyword :: !Bool+ , filtHeader :: !Bool+ , filtString :: !Bool+ , filtNumber :: !Bool+ , filtChar :: !Bool+ , filtOper :: !Bool+ } deriving (Eq)+++instance SemanticToken Token where+ tkIsIdentifier = isIdentifier+ tkIsString = isString+ tkIsChar = isChar+ tkIsNumber = isLiteralNumber+ tkIsKeyword = isKeyword+ tkEquivalent = tokenCompare+ tkToString = toString+ tkToOffset = toOffset+ tkToIdentif = TokenIdentifier+++-- Tokenize the source code in a list of Token+-- Precondition: the C++ source code must be well-formed+--++tokenizer :: Source -> [Token]+tokenizer xs = runGetToken (TokenizerState ys n Null)+ where (ys, n) = dropWhite xs+++tokenFilter :: TokenFilter -> Token -> Bool+tokenFilter filt (TokenIdentifier{}) = filtIdentifier filt+tokenFilter filt (TokenDirective{}) = filtDirective filt+tokenFilter filt (TokenKeyword{}) = filtKeyword filt+tokenFilter filt (TokenHeaderName{}) = filtHeader filt+tokenFilter filt (TokenNumber{}) = filtNumber filt+tokenFilter filt (TokenString{}) = filtString filt+tokenFilter filt (TokenChar{}) = filtChar filt+tokenFilter filt (TokenOperOrPunct{}) = filtOper filt+++tokenCompare :: Token -> Token -> Bool+tokenCompare (TokenIdentifier { toString = l }) (TokenIdentifier { toString = r }) = l == r+tokenCompare (TokenDirective { toString = l }) (TokenDirective { toString = r }) = l == r+tokenCompare (TokenKeyword { toString = l }) (TokenKeyword { toString = r }) = l == r+tokenCompare (TokenNumber { toString = l }) (TokenNumber { toString = r }) = l == r+tokenCompare (TokenHeaderName { toString = l }) (TokenHeaderName { toString = r }) = l == r+tokenCompare (TokenString { toString = l }) (TokenString { toString = r }) = l == r+tokenCompare (TokenChar { toString = l }) (TokenChar { toString = r }) = l == r+tokenCompare (TokenOperOrPunct{ toString = l }) (TokenOperOrPunct{ toString = r }) = l == r+tokenCompare _ _ = False+++isIdentifier :: Token -> Bool+isIdentifier (TokenIdentifier {}) = True+isIdentifier _ = False+++isKeyword :: Token -> Bool+isKeyword (TokenKeyword {}) = True+isKeyword _ = False+++isDirective :: Token -> Bool+isDirective (TokenDirective {}) = True+isDirective _ = False+++isLiteralNumber :: Token -> Bool+isLiteralNumber (TokenNumber {}) = True+isLiteralNumber _ = False+++isHeaderName :: Token -> Bool+isHeaderName (TokenHeaderName {}) = True+isHeaderName _ = False+++isString :: Token -> Bool+isString (TokenString {}) = True+isString _ = False+++isChar :: Token -> Bool+isChar (TokenChar {}) = True+isChar _ = False+++isOperOrPunct :: Token -> Bool+isOperOrPunct (TokenOperOrPunct {}) = True+isOperOrPunct _ = False+++isIdentifierChar' :: Char -> Bool+isIdentifierChar' = ((listArray ('\0', '\255') (map (\c -> isAlphaNum c || c == '_' || c == '$') ['\0'..'\255']) :: UArray Char Bool) !) -- GNU allows $ in identifier+++isChar' :: Char -> Bool+isChar'= ((listArray ('\0', '\255') (map (\c -> isSpace c || c == '\\') ['\0'..'\255']) :: UArray Char Bool) !)++-- Drop leading whitespace and count them+--++{-# INLINE dropWhite #-}++dropWhite :: Source -> (Source, Offset)+dropWhite xs = (xs', doff)+ where xs' = C.dropWhile isChar' xs+ doff = fromIntegral $ C.length xs - C.length xs'+++data CppState = Null | Hash | Include | Define | Undef | If | Ifdef | Ifndef | Elif | Else | Endif |+ Line | Error | Pragma+ deriving (Show, Eq)+++directiveKeys :: HM.HashMap String CppState+directiveKeys = HM.fromList [ ("#", Hash),+ ("include", Include),+ ("include_next", Include),+ ("define", Define),+ ("undef", Undef),+ ("if", If),+ ("ifdef", Ifdef),+ ("ifndef", Ifndef),+ ("elif", Elif),+ ("else", Else),+ ("endif", Null),+ ("line", Line),+ ("error", Error),+ ("pragma", Pragma) ]+++nextCppState :: String -> CppState -> CppState+nextCppState str pps+ | Hash <- pps = fromMaybe Null (HM.lookup str directiveKeys)+ | otherwise = if str == "#" then Hash else Null+++runGetToken :: TokenizerState -> [Token]++runGetToken (TokenizerState (C.uncons -> Nothing) _ _) = []+runGetToken tstate = token : runGetToken ns+ where (token, ns) = getToken tstate+++getToken :: TokenizerState -> (Token, TokenizerState)++getToken (TokenizerState (C.uncons -> Nothing) _ _) = error "getToken: internal error"+getToken (TokenizerState xs off state) =+ let token = fromJust $+ getTokenDirective xs state `mplus`+ getTokenHeaderName xs state `mplus`+ getTokenNumber xs state `mplus`+ getTokenString xs state `mplus`+ getTokenChar xs state `mplus`+ getTokenIdOrKeyword xs state `mplus`+ getTokenOpOrPunct xs state+ tstring = toString token+ len = fromIntegral $ length tstring+ (xs', w) = dropWhite $ C.drop (fromIntegral len) xs+ in+ (token { toOffset = off }, TokenizerState xs' (off + len + w) (nextCppState tstring state))+++getTokenIdOrKeyword, getTokenNumber,+ getTokenHeaderName, getTokenString,+ getTokenChar, getTokenOpOrPunct,+ getTokenDirective :: Source -> CppState -> Maybe Token+++getTokenDirective xs state+ | state == Hash = Just (TokenDirective name 0)+ | otherwise = Nothing+ where name = C.unpack $ C.takeWhile isIdentifierChar' xs+++getTokenHeaderName (C.uncons -> Nothing) _ = error "getTokenHeaderName: internal error"+getTokenHeaderName xs@(C.uncons -> Just (x,_)) state+ | state /= Include = Nothing+ | x == '<' = Just $ TokenHeaderName (getLiteral '<' '>' False xs) 0+ | x == '"' = Just $ TokenHeaderName (getLiteral '"' '"' False xs) 0+ | otherwise = Just $ TokenHeaderName (C.unpack $ C.takeWhile isIdentifierChar' xs) 0++getTokenHeaderName _ _ = undefined+++getTokenNumber ys@(C.uncons -> Just (x,_)) _+ | x == '.' || isDigit x = let ts = getNumber ys NumberNothing in+ case ts of+ "" -> Nothing+ "." -> Nothing+ _ -> Just $ TokenNumber ts 0+ | otherwise = Nothing+getTokenNumber (C.uncons -> Nothing) _ = Nothing+getTokenNumber _ _ = undefined+++validHexSet, validOctSet, validDecSet :: HS.HashSet Char++validHexSet = HS.fromList "0123456789abcdefABCDEFxX"+validOctSet = HS.fromList "01234567"+validDecSet = HS.fromList "0123456789"++data NumberState = NumberNothing | NumberOHF | NumberDec | NumberOct | NumberHex | NumberMayBeFloat | NumberFloat | NumberExp+ deriving (Show,Eq,Enum)++getNumber :: C.ByteString -> NumberState -> String+-- getNumber xs s | trace ("state = " ++ show s) False = undefined++getNumber (C.uncons -> Nothing) _ = ""+getNumber (C.uncons -> Just (x,xs)) state+ | state == NumberNothing = case () of _+ | x == '0' -> x : getNumber xs NumberOHF+ | x == '.' -> x : getNumber xs NumberMayBeFloat+ | isDigit x -> x : getNumber xs NumberDec+ | otherwise -> ""+ | state == NumberOHF = case () of _+ | x `HS.member` validHexSet -> x : getNumber xs NumberHex+ | x == '.' -> x : getNumber xs NumberMayBeFloat+ | isDigit x -> x : getNumber xs NumberOct+ | otherwise -> ""++ | state == NumberDec = case () of _+ | x `HS.member` validDecSet -> x : getNumber xs NumberDec+ | x == '.' -> x : getNumber xs NumberMayBeFloat+ | x == 'e' || x == 'E' -> x : getNumber xs NumberExp+ | otherwise -> ""++ | state == NumberOct = case () of _+ | x `HS.member` validOctSet -> x : getNumber xs NumberOct+ | otherwise -> ""++ | state == NumberHex = case () of _+ | x `HS.member` validHexSet -> x : getNumber xs NumberHex+ | otherwise -> ""++ | state == NumberMayBeFloat = case () of _+ | x `HS.member` validDecSet -> x : getNumber xs NumberFloat+ | otherwise -> ""++ | state == NumberFloat = case () of _+ | x `HS.member` validDecSet -> x : getNumber xs NumberFloat+ | x == 'e' || x == 'E' -> x : getNumber xs NumberExp+ | otherwise -> ""++ | state == NumberExp = case () of _+ | x `HS.member` validDecSet -> x : getNumber xs NumberExp+ | x == '+' || x == '-' -> x : getNumber xs NumberExp+ | otherwise -> ""++getNumber _ _ = undefined+++getTokenString xs@(C.uncons -> Just (x,_)) _+ | x == '"' = Just $ TokenString (getLiteral '"' '"' False xs) 0+ | otherwise = Nothing+getTokenString (C.uncons -> Nothing) _ = Nothing+getTokenString _ _ = Nothing+++getTokenChar xs@(C.uncons -> Just (x,_)) _+ | x == '\'' = Just $ TokenChar (getLiteral '\'' '\'' False xs) 0+ | otherwise = Nothing+getTokenChar (C.uncons -> Nothing) _ = Nothing+getTokenChar _ _ = Nothing+++getTokenIdOrKeyword xs@(C.uncons -> Just (x,_)) _+ | not $ isIdentifierChar' x = Nothing+ | name `HS.member` keywords = Just $ TokenKeyword name 0+ | otherwise = Just $ TokenIdentifier name 0+ where name = C.unpack $ C.takeWhile isIdentifierChar' xs+getTokenIdOrKeyword (C.uncons -> Nothing) _ = Nothing+getTokenIdOrKeyword _ _ = Nothing+++getTokenOpOrPunct source _ = go source (min 4 (C.length source))+ where go _ 0+ | C.length source > 0 = error $ "operator or punct: error " ++ show source+ | otherwise = Nothing+ go src len+ | sub `HS.member` operOrPunct = Just $ TokenOperOrPunct sub 0+ | otherwise = go src (len-1)+ where sub = C.unpack (C.take len src)+++getLiteral :: Char -> Char -> Bool -> C.ByteString -> String+getLiteral _ _ _ (C.uncons -> Nothing) = []+getLiteral b e False ys@(C.uncons -> Just (x,xs))+ | x == b = b : getLiteral b e True xs+ | otherwise = error $ "literal: error " ++ C.unpack ys+getLiteral b e True (C.uncons -> Just (x,xs))+ | x == e = [e]+ | x == '\\' = '\\' : x' : getLiteral b e True xs'+ | otherwise = x : getLiteral b e True xs+ where+ (C.uncons -> Just(x',xs')) = xs+getLiteral _ _ _ _ = []+++operOrPunct :: HS.HashSet String+operOrPunct = HS.fromList [ "{","}","[","]","#","(",")",";",":","?",".","+","-","*",+ "/","%","^","&","|","~","!","=","<",">","," ,+ "##", "<:", ":>", "<%", "%>", "%:", "::", ".*", "+=", "-=",+ "*=", "/=", "%=", "^=", "&=", "|=", "<<", ">>", ">=", "<=",+ "&&", "||", "==", "!=", "++", "--", "->", "//", "/*", "*/",+ "...", "<<=", ">>=", "->*",+ "%:%:" ]++keywords :: HS.HashSet String+keywords = HS.fromList ["alignas", "continue", "friend", "alignof", "decltype", "goto", "asm",+ "default", "if", "auto", "delete", "inline", "bool", "do", "int", "break",+ "double", "long", "case", "dynamic_cast", "mutable", "catch", "else",+ "namespace", "char", "enum", "new", "char16_t", "explicit", "noexcept",+ "char32_t", "export", "nullptr", "class", "extern", "operator", "const",+ "false", "private", "constexpr", "float", "protected", "const_cast", "for",+ "public", "register", "true", "reinterpret_cast", "try", "return", "typedef",+ "short", "typeid", "signed", "typename", "sizeof", "union", "static", "unsigned",+ "static_assert", "using", "static_cast", "virtual", "struct", "void", "switch",+ "volatile", "template", "wchar_t", "this", "while", "thread_local", "throw",+ "and", "and_eq", "bitand", "bitor", "compl", "not", "not_eq", "or", "or_eq",+ "xor", "xor_eq"]+
+ src/CGrep/Parser/Generic/Token.hs view
@@ -0,0 +1,213 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++{-# LANGUAGE FlexibleInstances #-}+++module CGrep.Parser.Generic.Token (tokenizer, Token(..)) where++import qualified Data.ByteString.Char8 as C+import qualified Data.DList as DL++import Data.Char+import Data.Array.Unboxed++import CGrep.Parser.Token+import CGrep.Types++type DString = DL.DList Char+++data TokenState =+ StateSpace |+ StateAlpha |+ StateDigit |+ StateBracket |+ StateLit1 |+ StateLit2 |+ StateOther+ deriving (Eq, Enum, Show)+++data Token =+ TokenAlpha { toString :: !String, toOffset :: {-# UNPACK #-} !Offset } |+ TokenDigit { toString :: !String, toOffset :: {-# UNPACK #-} !Offset } |+ TokenBracket { toString :: !String, toOffset :: {-# UNPACK #-} !Offset } |+ TokenLiteral { toString :: !String, toOffset :: {-# UNPACK #-} !Offset } |+ TokenOther { toString :: !String, toOffset :: {-# UNPACK #-} !Offset }+ deriving (Show, Eq, Ord)+++instance SemanticToken Token where+ tkIsIdentifier = _isTokenAlpha+ tkIsString = _isTokenLiteral+ tkIsChar = _isTokenLiteral+ tkIsNumber = _isTokenDigit+ tkIsKeyword = const False+ tkEquivalent = tokenCompare+ tkToString = toString+ tkToOffset = toOffset+ tkToIdentif = TokenAlpha+++_isTokenAlpha, _isTokenDigit, _isTokenBracket, _isTokenOther, _isTokenLiteral :: Token -> Bool++_isTokenAlpha (TokenAlpha _ _) = True+_isTokenAlpha _ = False++_isTokenDigit (TokenDigit _ _) = True+_isTokenDigit _ = False++_isTokenBracket (TokenBracket _ _) = True+_isTokenBracket _ = False++_isTokenLiteral (TokenLiteral _ _) = True+_isTokenLiteral _ = False++_isTokenOther (TokenOther _ _) = True+_isTokenOther _ = False+++tokenCompare :: Token -> Token -> Bool+tokenCompare (TokenAlpha { toString = l }) (TokenAlpha { toString = r }) = l == r+tokenCompare (TokenDigit { toString = l }) (TokenDigit { toString = r }) = l == r+tokenCompare (TokenLiteral { toString = l }) (TokenLiteral { toString = r }) = l == r+tokenCompare (TokenBracket { toString = l }) (TokenBracket { toString = r }) = l == r+tokenCompare (TokenOther { toString = l }) (TokenOther { toString = r }) = l == r+tokenCompare _ _ = False+++data TokenAccum = TokenAccum !TokenState {-# UNPACK #-} !Offset {-# UNPACK #-} !Int DString (DL.DList Token)+++isCharNumberLT :: UArray Char Bool+isCharNumberLT =+ listArray ('\0', '\255')+ (map (\c -> isHexDigit c || c `elem` ".xX") ['\0'..'\255'])+++isSpaceLT :: UArray Char Bool+isSpaceLT =+ listArray ('\0', '\255')+ (map isSpace ['\0'..'\255'])++isAlphaLT :: UArray Char Bool+isAlphaLT =+ listArray ('\0', '\255')+ (map (\c -> isAlpha c || c == '_') ['\0'..'\255'])++isAlphaNumLT :: UArray Char Bool+isAlphaNumLT =+ listArray ('\0', '\255')+ (map (\c -> isAlphaNum c || c == '_' || c == '\'') ['\0'..'\255'])++isDigitLT :: UArray Char Bool+isDigitLT =+ listArray ('\0', '\255')+ (map isDigit ['\0'..'\255'])++isBracketLT :: UArray Char Bool+isBracketLT =+ listArray ('\0', '\255')+ (map (`elem` "{[()]}") ['\0'..'\255'])+++{-# INLINE mkToken #-}+++mkToken :: (String -> Offset -> Token) -> Offset -> DString -> Token+mkToken ctor off ds = ctor str (off - length str)+ where str = DL.toList ds+++mkTokenCtor :: TokenState -> String -> Offset -> Token+mkTokenCtor StateSpace = TokenOther+mkTokenCtor StateAlpha = TokenAlpha+mkTokenCtor StateDigit = TokenDigit+mkTokenCtor StateBracket = TokenBracket+mkTokenCtor StateLit1 = TokenLiteral+mkTokenCtor StateLit2 = TokenLiteral+mkTokenCtor StateOther = TokenOther+++tokenizer :: Text8 -> [Token]+tokenizer xs = (\(TokenAccum ss off _ acc out) ->+ DL.toList (if null (DL.toList acc) then out+ else out `DL.snoc` mkToken (mkTokenCtor ss) off acc)) $ C.foldl' tokens' (TokenAccum StateSpace 0 0 DL.empty DL.empty) xs+ where tokens' :: TokenAccum -> Char -> TokenAccum+ tokens' (TokenAccum StateSpace off _ _ out) x =+ case () of+ _ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) 0 DL.empty out+ | x == '\'' -> TokenAccum StateLit1 (off+1) 0 (DL.singleton x) out+ | x == '"' -> TokenAccum StateLit2 (off+1) 0 (DL.singleton x) out+ | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) 0 (DL.singleton x) out+ | isDigitLT ! x -> TokenAccum StateDigit (off+1) 0 (DL.singleton x) out+ | isBracketLT ! x -> TokenAccum StateBracket (off+1) 0 (DL.singleton x) out+ | otherwise -> TokenAccum StateOther (off+1) 0 (DL.singleton x) out++ tokens' (TokenAccum StateAlpha off _ acc out) x =+ case () of+ _ | isAlphaNumLT ! x -> TokenAccum StateAlpha (off+1) 0 (acc `DL.snoc` x) out+ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) 0 DL.empty (out `DL.snoc` mkToken TokenAlpha off acc)+ | isBracketLT ! x -> TokenAccum StateBracket (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenAlpha off acc)+ | otherwise -> TokenAccum StateOther (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenAlpha off acc)++ tokens' (TokenAccum StateDigit off _ acc out) x =+ case () of+ _ | isCharNumberLT ! x -> TokenAccum StateDigit (off+1) 0 (acc `DL.snoc` x) out+ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) 0 DL.empty (out `DL.snoc` mkToken TokenDigit off acc)+ | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenDigit off acc)+ | isBracketLT ! x -> TokenAccum StateBracket (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenDigit off acc)+ | otherwise -> TokenAccum StateOther (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenDigit off acc)++ tokens' (TokenAccum StateLit1 off skip acc out) x =+ case () of+ _ | skip > 0 -> TokenAccum StateLit1 (off+1) (skip-1) (acc `DL.snoc` x) out+ | x == '\\' -> TokenAccum StateLit1 (off+1) 1 (acc `DL.snoc` x) out+ | x == '\'' -> TokenAccum StateSpace (off+1) 0 DL.empty (out `DL.snoc` mkToken TokenLiteral (off+1) (acc `DL.snoc` '\''))+ | otherwise -> TokenAccum StateLit1 (off+1) 0 (acc `DL.snoc` x) out++ tokens' (TokenAccum StateLit2 off skip acc out) x =+ case () of+ _ | skip > 0 -> TokenAccum StateLit2 (off+1) (skip-1) (acc `DL.snoc` x) out+ | x == '\\' -> TokenAccum StateLit2 (off+1) 1 (acc `DL.snoc` x) out+ | x == '"' -> TokenAccum StateSpace (off+1) 0 DL.empty (out `DL.snoc` mkToken TokenLiteral (off+1) (acc `DL.snoc` '"'))+ | otherwise -> TokenAccum StateLit2 (off+1) 0 (acc `DL.snoc` x) out++ tokens' (TokenAccum StateBracket off _ acc out) x =+ case () of+ _ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) 0 DL.empty (out `DL.snoc` mkToken TokenBracket off acc)+ | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)+ | isDigitLT ! x -> TokenAccum StateDigit (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)+ | isBracketLT ! x -> TokenAccum StateBracket (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)+ | x == '\'' -> TokenAccum StateLit1 (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)+ | x == '"' -> TokenAccum StateLit2 (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)+ | otherwise -> TokenAccum StateOther (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)++ tokens' (TokenAccum StateOther off _ acc out) x =+ case () of+ _ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) 0 DL.empty (out `DL.snoc` mkToken TokenOther off acc)+ | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenOther off acc)+ | isDigitLT ! x -> if DL.toList acc == "."+ then TokenAccum StateDigit (off+1) 0 (acc `DL.snoc` x) out+ else TokenAccum StateDigit (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenOther off acc)+ | isBracketLT ! x -> TokenAccum StateBracket (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenOther off acc)+ | x == '\'' -> TokenAccum StateLit1 (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)+ | x == '"' -> TokenAccum StateLit2 (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)+ | otherwise -> TokenAccum StateOther (off+1) 0 (acc `DL.snoc` x) out+
+ src/CGrep/Parser/Token.hs view
@@ -0,0 +1,32 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++module CGrep.Parser.Token (SemanticToken(..)) where+++class (Show t, Ord t) => SemanticToken t where+ tkIsIdentifier :: t -> Bool+ tkIsString :: t -> Bool+ tkIsChar :: t -> Bool+ tkIsNumber :: t -> Bool+ tkIsKeyword :: t -> Bool+ tkEquivalent :: t -> t -> Bool+ tkToString :: t -> String+ tkToOffset :: t -> Int+ tkToIdentif :: String -> Int -> t+
+ src/CGrep/Parser/WildCard.hs view
@@ -0,0 +1,220 @@+--+-- Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>+--+-- This program is free software; you can redistribute it and/or modify+-- it under the terms of the GNU General Public License as published by+-- the Free Software Foundation; either version 2 of the License, or+-- (at your option) any later version.+--+-- This program is distributed in the hope that it will be useful,+-- but WITHOUT ANY WARRANTY; without even the implied warranty of+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the+-- GNU General Public License for more details.+--+-- You should have received a copy of the GNU General Public License+-- along with this program; if not, write to the Free Software+-- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.+--++module CGrep.Parser.WildCard (WildCard(..), MultiCard,+ mkWildCardFromToken,+ combineMultiCard,+ filterTokensWithMultiCards,+ wildCardMatch,+ multiCardMatch) where++import qualified Data.Map as M++import CGrep.Common+import CGrep.Distance+import CGrep.Parser.Token++import Data.Char+import Data.List+import Options+import Util+++data WildCard a =+ TokenCard a |+ AnyCard |+ KeyWordCard |+ NumberCard |+ OctCard |+ HexCard |+ StringCard |+ LiteralCard |+ CharCard |+ IdentifCard String+ deriving (Show, Eq, Ord)++++type MultiCard a = [WildCard a]+++wildCardMap :: M.Map String (WildCard a)+wildCardMap = M.fromList+ [+ ("ANY", AnyCard ),+ ("KEY", KeyWordCard ),+ ("OCT", OctCard ),+ ("HEX", HexCard ),+ ("NUM", NumberCard ),+ ("CHR", CharCard ),+ ("STR", StringCard ),+ ("LIT", StringCard )+ ]+++mkWildCardFromToken :: (SemanticToken a) => a -> WildCard a+mkWildCardFromToken t+ | tkIsIdentifier t = case () of+ _ | Just wc <- M.lookup str wildCardMap -> wc+ | isWildCardIdentif str -> IdentifCard str+ | otherwise -> TokenCard $ tkToIdentif (rmWildCardEscape str) (tkToOffset t)+ where str = tkToString t++ | otherwise = TokenCard t+++combineMultiCard :: (SemanticToken a) => [MultiCard a] -> [MultiCard a]+combineMultiCard (m1:r@(m2:m3:ms))+ | [TokenCard b] <- m2, tkToString b == "OR" = combineMultiCard $ (m1++m3):ms+ | otherwise = m1 : combineMultiCard r+combineMultiCard [m1,m2] = [m1,m2]+combineMultiCard [m1] = [m1]+combineMultiCard [] = []+++filterTokensWithMultiCards :: (SemanticToken a) => Options -> [MultiCard a] -> [a] -> [a]+filterTokensWithMultiCards opt ws = filterTokensWithMultiCards' opt (spanOptionalCards ws)+++filterTokensWithMultiCards' :: (SemanticToken a) => Options -> [[MultiCard a]] -> [a] -> [a]+filterTokensWithMultiCards' _ [] _ = []+filterTokensWithMultiCards' opt (g:gs) ts =+ concatMap (take grpLen . (`drop` ts)) (findIndices (multiCardCompare opt g) grp) +++ filterTokensWithMultiCards' opt gs ts+ where grp = spanGroup grpLen ts+ grpLen = length g+++spanOptionalCards :: [MultiCard a] -> [[MultiCard a]]+spanOptionalCards wc = map (`filterCardIndicies` wc') idx+ where wc' = zip [0..] wc+ idx = subsequences $+ findIndices (\w -> case w of+ [IdentifCard ('$':_)] -> True+ _ -> False) wc+++filterCardIndicies :: [Int] -> [(Int, MultiCard a)] -> [MultiCard a]+filterCardIndicies ns ps = map snd $ filter (\(n, _) -> n `notElem` ns) ps+++multiCardCompare :: (SemanticToken a) => Options -> [MultiCard a] -> [a] -> Bool+multiCardCompare opt l r =+ multiCardCompareAll ts && multiCardCheckOccurences ts+ where ts = multiCardGroupCompare opt l r+++isWildCardIdentif :: String -> Bool+isWildCardIdentif s =+ case () of+ _ | (x:y:_) <- s -> wprefix x && isNumber y+ | [x] <- s -> wprefix x+ | otherwise -> error "isWildCardIdentif"+ where wprefix x = x == '$' || x == '_'+++rmWildCardEscape :: String -> String+rmWildCardEscape ('$':xs) = xs+rmWildCardEscape ('_':xs) = xs+rmWildCardEscape xs = xs+++{-# INLINE multiCardCompareAll #-}++multiCardCompareAll :: [(Bool, (MultiCard a, [String]))] -> Bool+multiCardCompareAll = all fst+++{-# INLINE multiCardCheckOccurences #-}++-- Note: pattern $ and _ match any token, whereas $1 $2 (_1 _2 etc.) match tokens+-- that must compare equal in the respective occurrences+--++multiCardCheckOccurences :: (SemanticToken a) => [(Bool, (MultiCard a, [String]))] -> Bool+multiCardCheckOccurences ts = M.foldr (\xs r -> r && all (== head xs) xs) True m+ where m = M.mapWithKey (\k xs ->+ case k of+ [IdentifCard "_0"] -> xs+ [IdentifCard "_1"] -> xs+ [IdentifCard "_2"] -> xs+ [IdentifCard "_3"] -> xs+ [IdentifCard "_4"] -> xs+ [IdentifCard "_5"] -> xs+ [IdentifCard "_6"] -> xs+ [IdentifCard "_7"] -> xs+ [IdentifCard "_8"] -> xs+ [IdentifCard "_9"] -> xs+ [IdentifCard "$0"] -> xs+ [IdentifCard "$1"] -> xs+ [IdentifCard "$2"] -> xs+ [IdentifCard "$3"] -> xs+ [IdentifCard "$4"] -> xs+ [IdentifCard "$5"] -> xs+ [IdentifCard "$6"] -> xs+ [IdentifCard "$7"] -> xs+ [IdentifCard "$8"] -> xs+ [IdentifCard "$9"] -> xs+ _ -> []+ ) $ M.fromListWith (++) (map snd ts)+++multiCardGroupCompare :: (SemanticToken a) => Options -> [MultiCard a] -> [a] -> [(Bool, (MultiCard a, [String]))]+multiCardGroupCompare opt ls rs+ | length rs >= length ls = zipWith (tokensZip opt) ls rs+ | otherwise = [ (False, ([AnyCard], [])) ]+++tokensZip :: (SemanticToken a) => Options -> MultiCard a -> a -> (Bool, (MultiCard a, [String]))+tokensZip opt l r+ | multiCardMatch opt l r = (True, (l, [tkToString r]))+ | otherwise = (False, ([AnyCard],[] ))+++multiCardMatch :: (SemanticToken t) => Options -> MultiCard t -> t -> Bool+multiCardMatch opt m t = any (\w -> wildCardMatch opt w t) m++wildCardMatch :: (SemanticToken t) => Options -> WildCard t -> t -> Bool+wildCardMatch _ AnyCard _ = True+wildCardMatch _ (IdentifCard _) t = tkIsIdentifier t+wildCardMatch _ KeyWordCard t = tkIsKeyword t+wildCardMatch _ StringCard t = tkIsString t+wildCardMatch _ CharCard t = tkIsChar t+wildCardMatch _ LiteralCard t = tkIsString t || tkIsChar t+wildCardMatch _ NumberCard t = tkIsNumber t+wildCardMatch _ OctCard t = tkIsNumber t && case tkToString t of ('0':d: _) -> isDigit d; _ -> False+wildCardMatch _ HexCard t = tkIsNumber t && case tkToString t of ('0':'x':_) -> True; _ -> False+wildCardMatch opt (TokenCard l) r+ | tkIsIdentifier l && tkIsIdentifier r =+ case () of+ _ | edit_dist opt -> tkToString l ~== tkToString r+ | word_match opt -> tkToString l == tkToString r+ | prefix_match opt -> tkToString l `isPrefixOf` tkToString r+ | suffix_match opt -> tkToString l `isSuffixOf` tkToString r+ | otherwise -> tkToString l `isInfixOf` tkToString r+ | tkIsString l && tkIsString r =+ case () of+ _ | edit_dist opt -> ls ~== rs+ | word_match opt -> ls == rs+ | prefix_match opt -> ls `isPrefixOf` rs+ | suffix_match opt -> ls `isSuffixOf` rs+ | otherwise -> ls `isInfixOf` rs+ where ls = rmQuote $ trim (tkToString l)+ rs = rmQuote $ trim (tkToString r)+ | otherwise = l `tkEquivalent` r+
− src/CGrep/Semantic/Cpp/Token.hs
@@ -1,381 +0,0 @@------ Copyright (c) 2012-2013 Bonelli Nicola <bonelli@antifork.org>------ This program is free software; you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation; either version 2 of the License, or--- (at your option) any later version.------ This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the--- GNU General Public License for more details.------ You should have received a copy of the GNU General Public License--- along with this program; if not, write to the Free Software--- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.-----{-# LANGUAGE ViewPatterns #-}--module CGrep.Semantic.Cpp.Token(Token(..), TokenFilter(..),- Offset, tokenizer, tokenFilter, tokenCompare,- isIdentifier, isKeyword, isDirective, isLiteralNumber,- isHeaderName, isString, isChar, isOperOrPunct- ) where--import Data.Char-import Data.Maybe-import Control.Monad-import Data.Array.Unboxed--import qualified Data.HashSet as HS-import qualified Data.HashMap.Strict as HM-import qualified Data.ByteString.Char8 as C--import CGrep.Semantic.Token--data TokenizerState = TokenizerState Source {-# UNPACK #-} !Offset !CppState-type Source = C.ByteString-type Offset = Int---data Token =- TokenIdentifier { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |- TokenDirective { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |- TokenKeyword { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |- TokenNumber { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |- TokenHeaderName { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |- TokenString { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |- TokenChar { toString :: !String, toOffset :: {-# UNPACK #-} !Int } |- TokenOperOrPunct { toString :: !String, toOffset :: {-# UNPACK #-} !Int }- deriving (Show, Eq, Ord)---data TokenFilter = TokenFilter- { filtIdentifier :: !Bool- , filtDirective :: !Bool- , filtKeyword :: !Bool- , filtHeader :: !Bool- , filtString :: !Bool- , filtNumber :: !Bool- , filtChar :: !Bool- , filtOper :: !Bool- } deriving (Eq)---instance SemanticToken Token where- tkIsIdentifier = isIdentifier- tkIsString = isString- tkIsChar = isChar- tkIsNumber = isLiteralNumber- tkIsKeyword = isKeyword- tkEquivalent = tokenCompare- tkToString = toString- tkToOffset = toOffset- tkToIdentif = TokenIdentifier----- Tokenize the source code in a list of Token--- Precondition: the C++ source code must be well-formed-----tokenizer :: Source -> [Token]-tokenizer xs = runGetToken (TokenizerState ys n Null)- where (ys, n) = dropWhite xs---tokenFilter :: TokenFilter -> Token -> Bool-tokenFilter filt (TokenIdentifier{}) = filtIdentifier filt-tokenFilter filt (TokenDirective{}) = filtDirective filt-tokenFilter filt (TokenKeyword{}) = filtKeyword filt-tokenFilter filt (TokenHeaderName{}) = filtHeader filt-tokenFilter filt (TokenNumber{}) = filtNumber filt-tokenFilter filt (TokenString{}) = filtString filt-tokenFilter filt (TokenChar{}) = filtChar filt-tokenFilter filt (TokenOperOrPunct{}) = filtOper filt---tokenCompare :: Token -> Token -> Bool-tokenCompare (TokenIdentifier { toString = l }) (TokenIdentifier { toString = r }) = l == r-tokenCompare (TokenDirective { toString = l }) (TokenDirective { toString = r }) = l == r-tokenCompare (TokenKeyword { toString = l }) (TokenKeyword { toString = r }) = l == r-tokenCompare (TokenNumber { toString = l }) (TokenNumber { toString = r }) = l == r-tokenCompare (TokenHeaderName { toString = l }) (TokenHeaderName { toString = r }) = l == r-tokenCompare (TokenString { toString = l }) (TokenString { toString = r }) = l == r-tokenCompare (TokenChar { toString = l }) (TokenChar { toString = r }) = l == r-tokenCompare (TokenOperOrPunct{ toString = l }) (TokenOperOrPunct{ toString = r }) = l == r-tokenCompare _ _ = False---isIdentifier :: Token -> Bool-isIdentifier (TokenIdentifier {}) = True-isIdentifier _ = False---isKeyword :: Token -> Bool-isKeyword (TokenKeyword {}) = True-isKeyword _ = False---isDirective :: Token -> Bool-isDirective (TokenDirective {}) = True-isDirective _ = False---isLiteralNumber :: Token -> Bool-isLiteralNumber (TokenNumber {}) = True-isLiteralNumber _ = False---isHeaderName :: Token -> Bool-isHeaderName (TokenHeaderName {}) = True-isHeaderName _ = False---isString :: Token -> Bool-isString (TokenString {}) = True-isString _ = False---isChar :: Token -> Bool-isChar (TokenChar {}) = True-isChar _ = False---isOperOrPunct :: Token -> Bool-isOperOrPunct (TokenOperOrPunct {}) = True-isOperOrPunct _ = False---isIdentifierChar' :: Char -> Bool-isIdentifierChar' = ((listArray ('\0', '\255') (map (\c -> isAlphaNum c || c == '_' || c == '$') ['\0'..'\255']) :: UArray Char Bool) !) -- GNU allows $ in identifier---isChar' :: Char -> Bool-isChar'= ((listArray ('\0', '\255') (map (\c -> isSpace c || c == '\\') ['\0'..'\255']) :: UArray Char Bool) !)---- Drop leading whitespace and count them-----{-# INLINE dropWhite #-}--dropWhite :: Source -> (Source, Offset)-dropWhite xs = (xs', doff)- where xs' = C.dropWhile isChar' xs- doff = fromIntegral $ C.length xs - C.length xs'---data CppState = Null | Hash | Include | Define | Undef | If | Ifdef | Ifndef | Elif | Else | Endif |- Line | Error | Pragma- deriving (Show, Eq)---directiveKeys :: HM.HashMap String CppState-directiveKeys = HM.fromList [ ("#", Hash),- ("include", Include),- ("include_next", Include),- ("define", Define),- ("undef", Undef),- ("if", If),- ("ifdef", Ifdef),- ("ifndef", Ifndef),- ("elif", Elif),- ("else", Else),- ("endif", Null),- ("line", Line),- ("error", Error),- ("pragma", Pragma) ]---nextCppState :: String -> CppState -> CppState-nextCppState str pps- | Hash <- pps = fromMaybe Null (HM.lookup str directiveKeys)- | otherwise = if str == "#" then Hash else Null---runGetToken :: TokenizerState -> [Token]--runGetToken (TokenizerState (C.uncons -> Nothing) _ _) = []-runGetToken tstate = token : runGetToken ns- where (token, ns) = getToken tstate---getToken :: TokenizerState -> (Token, TokenizerState)--getToken (TokenizerState (C.uncons -> Nothing) _ _) = error "getToken: internal error"-getToken (TokenizerState xs off state) =- let token = fromJust $- getTokenDirective xs state `mplus`- getTokenHeaderName xs state `mplus`- getTokenNumber xs state `mplus`- getTokenString xs state `mplus`- getTokenChar xs state `mplus`- getTokenIdOrKeyword xs state `mplus`- getTokenOpOrPunct xs state- tstring = toString token- len = fromIntegral $ length tstring- (xs', w) = dropWhite $ C.drop (fromIntegral len) xs- in- (token { toOffset = off }, (TokenizerState xs' (off + len + w) (nextCppState tstring state)))---getTokenIdOrKeyword, getTokenNumber,- getTokenHeaderName, getTokenString,- getTokenChar, getTokenOpOrPunct,- getTokenDirective :: Source -> CppState -> Maybe Token---getTokenDirective xs state- | state == Hash = Just (TokenDirective name 0)- | otherwise = Nothing- where name = C.unpack $ C.takeWhile isIdentifierChar' xs---getTokenHeaderName (C.uncons -> Nothing) _ = error "getTokenHeaderName: internal error"-getTokenHeaderName xs@(C.uncons -> Just (x,_)) state- | state /= Include = Nothing- | x == '<' = Just $ TokenHeaderName (getLiteral '<' '>' False xs) 0- | x == '"' = Just $ TokenHeaderName (getLiteral '"' '"' False xs) 0- | otherwise = Just $ TokenHeaderName (C.unpack $ C.takeWhile isIdentifierChar' xs) 0--getTokenHeaderName _ _ = undefined---getTokenNumber ys@(C.uncons -> Just (x,_)) _- | x == '.' || isDigit x = let ts = getNumber ys NumberNothing in- case ts of- "" -> Nothing- "." -> Nothing- _ -> Just $ TokenNumber ts 0- | otherwise = Nothing-getTokenNumber (C.uncons -> Nothing) _ = Nothing-getTokenNumber _ _ = undefined---validHexSet, validOctSet, validDecSet :: HS.HashSet Char--validHexSet = HS.fromList "0123456789abcdefABCDEFxX"-validOctSet = HS.fromList "01234567"-validDecSet = HS.fromList "0123456789"--data NumberState = NumberNothing | NumberOHF | NumberDec | NumberOct | NumberHex | NumberMayBeFloat | NumberFloat | NumberExp- deriving (Show,Eq,Enum)--getNumber :: C.ByteString -> NumberState -> String--- getNumber xs s | trace ("state = " ++ show s) False = undefined--getNumber (C.uncons -> Nothing) _ = ""-getNumber (C.uncons -> Just (x,xs)) state- | state == NumberNothing = case () of _- | x == '0' -> x : getNumber xs NumberOHF- | x == '.' -> x : getNumber xs NumberMayBeFloat- | isDigit x -> x : getNumber xs NumberDec- | otherwise -> ""- | state == NumberOHF = case () of _- | x `HS.member` validHexSet -> x : getNumber xs NumberHex- | x == '.' -> x : getNumber xs NumberMayBeFloat- | isDigit x -> x : getNumber xs NumberOct- | otherwise -> ""-- | state == NumberDec = case () of _- | x `HS.member` validDecSet -> x : getNumber xs NumberDec- | x == '.' -> x : getNumber xs NumberMayBeFloat- | x == 'e' || x == 'E' -> x : getNumber xs NumberExp- | otherwise -> ""-- | state == NumberOct = case () of _- | x `HS.member` validOctSet -> x : getNumber xs NumberOct- | otherwise -> ""-- | state == NumberHex = case () of _- | x `HS.member` validHexSet -> x : getNumber xs NumberHex- | otherwise -> ""-- | state == NumberMayBeFloat = case () of _- | x `HS.member` validDecSet -> x : getNumber xs NumberFloat- | otherwise -> ""-- | state == NumberFloat = case () of _- | x `HS.member` validDecSet -> x : getNumber xs NumberFloat- | x == 'e' || x == 'E' -> x : getNumber xs NumberExp- | otherwise -> ""-- | state == NumberExp = case () of _- | x `HS.member` validDecSet -> x : getNumber xs NumberExp- | x == '+' || x == '-' -> x : getNumber xs NumberExp- | otherwise -> ""--getNumber _ _ = undefined---getTokenString xs@(C.uncons -> Just (x,_)) _- | x == '"' = Just $ TokenString (getLiteral '"' '"' False xs) 0- | otherwise = Nothing-getTokenString (C.uncons -> Nothing) _ = Nothing-getTokenString _ _ = Nothing---getTokenChar xs@(C.uncons -> Just (x,_)) _- | x == '\'' = Just $ TokenChar (getLiteral '\'' '\'' False xs) 0- | otherwise = Nothing-getTokenChar (C.uncons -> Nothing) _ = Nothing-getTokenChar _ _ = Nothing---getTokenIdOrKeyword xs@(C.uncons -> Just (x,_)) _- | not $ isIdentifierChar' x = Nothing- | name `HS.member` keywords = Just $ TokenKeyword name 0- | otherwise = Just $ TokenIdentifier name 0- where name = C.unpack $ C.takeWhile isIdentifierChar' xs-getTokenIdOrKeyword (C.uncons -> Nothing) _ = Nothing-getTokenIdOrKeyword _ _ = Nothing---getTokenOpOrPunct source _ = go source (min 4 (C.length source))- where go _ 0- | C.length source > 0 = error $ "operator or punct: error " ++ show source- | otherwise = Nothing- go src len- | sub `HS.member` operOrPunct = Just $ TokenOperOrPunct sub 0- | otherwise = go src (len-1)- where sub = C.unpack (C.take len src)---getLiteral :: Char -> Char -> Bool -> C.ByteString -> String-getLiteral _ _ _ (C.uncons -> Nothing) = []-getLiteral b e False ys@(C.uncons -> Just (x,xs))- | x == b = b : getLiteral b e True xs- | otherwise = error $ "literal: error " ++ C.unpack ys-getLiteral b e True (C.uncons -> Just (x,xs))- | x == e = [e]- | x == '\\' = '\\' : x' : getLiteral b e True xs'- | otherwise = x : getLiteral b e True xs- where- (C.uncons -> Just(x',xs')) = xs-getLiteral _ _ _ _ = []---operOrPunct :: HS.HashSet String-operOrPunct = HS.fromList [ "{","}","[","]","#","(",")",";",":","?",".","+","-","*",- "/","%","^","&","|","~","!","=","<",">","," ,- "##", "<:", ":>", "<%", "%>", "%:", "::", ".*", "+=", "-=",- "*=", "/=", "%=", "^=", "&=", "|=", "<<", ">>", ">=", "<=",- "&&", "||", "==", "!=", "++", "--", "->", "//", "/*", "*/",- "...", "<<=", ">>=", "->*",- "%:%:" ]--keywords :: HS.HashSet String-keywords = HS.fromList ["alignas", "continue", "friend", "alignof", "decltype", "goto", "asm",- "default", "if", "auto", "delete", "inline", "bool", "do", "int", "break",- "double", "long", "case", "dynamic_cast", "mutable", "catch", "else",- "namespace", "char", "enum", "new", "char16_t", "explicit", "noexcept",- "char32_t", "export", "nullptr", "class", "extern", "operator", "const",- "false", "private", "constexpr", "float", "protected", "const_cast", "for",- "public", "register", "true", "reinterpret_cast", "try", "return", "typedef",- "short", "typeid", "signed", "typename", "sizeof", "union", "static", "unsigned",- "static_assert", "using", "static_cast", "virtual", "struct", "void", "switch",- "volatile", "template", "wchar_t", "this", "while", "thread_local", "throw",- "and", "and_eq", "bitand", "bitor", "compl", "not", "not_eq", "or", "or_eq",- "xor", "xor_eq"]-
− src/CGrep/Semantic/Generic/Token.hs
@@ -1,213 +0,0 @@------ Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>------ This program is free software; you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation; either version 2 of the License, or--- (at your option) any later version.------ This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the--- GNU General Public License for more details.------ You should have received a copy of the GNU General Public License--- along with this program; if not, write to the Free Software--- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.-----{-# LANGUAGE FlexibleInstances #-}---module CGrep.Semantic.Generic.Token (tokenizer, Token(..)) where--import qualified Data.ByteString.Char8 as C-import qualified Data.DList as DL--import Data.Char-import Data.Array.Unboxed--import CGrep.Semantic.Token-import CGrep.Types--type DString = DL.DList Char---data TokenState =- StateSpace |- StateAlpha |- StateDigit |- StateBracket |- StateLit1 |- StateLit2 |- StateOther- deriving (Eq, Enum, Show)---data Token =- TokenAlpha { toString :: !String, toOffset :: {-# UNPACK #-} !Offset } |- TokenDigit { toString :: !String, toOffset :: {-# UNPACK #-} !Offset } |- TokenBracket { toString :: !String, toOffset :: {-# UNPACK #-} !Offset } |- TokenLiteral { toString :: !String, toOffset :: {-# UNPACK #-} !Offset } |- TokenOther { toString :: !String, toOffset :: {-# UNPACK #-} !Offset }- deriving (Show, Eq, Ord)---instance SemanticToken Token where- tkIsIdentifier = _isTokenAlpha- tkIsString = _isTokenLiteral- tkIsChar = _isTokenLiteral- tkIsNumber = _isTokenDigit- tkIsKeyword = const False- tkEquivalent = tokenCompare- tkToString = toString- tkToOffset = toOffset- tkToIdentif = TokenAlpha---_isTokenAlpha, _isTokenDigit, _isTokenBracket, _isTokenOther, _isTokenLiteral :: Token -> Bool--_isTokenAlpha (TokenAlpha _ _) = True-_isTokenAlpha _ = False--_isTokenDigit (TokenDigit _ _) = True-_isTokenDigit _ = False--_isTokenBracket (TokenBracket _ _) = True-_isTokenBracket _ = False--_isTokenLiteral (TokenLiteral _ _) = True-_isTokenLiteral _ = False--_isTokenOther (TokenOther _ _) = True-_isTokenOther _ = False---tokenCompare :: Token -> Token -> Bool-tokenCompare (TokenAlpha { toString = l }) (TokenAlpha { toString = r }) = l == r-tokenCompare (TokenDigit { toString = l }) (TokenDigit { toString = r }) = l == r-tokenCompare (TokenLiteral { toString = l }) (TokenLiteral { toString = r }) = l == r-tokenCompare (TokenBracket { toString = l }) (TokenBracket { toString = r }) = l == r-tokenCompare (TokenOther { toString = l }) (TokenOther { toString = r }) = l == r-tokenCompare _ _ = False---data TokenAccum = TokenAccum !TokenState {-# UNPACK #-} !Offset {-# UNPACK #-} !Int DString (DL.DList Token)---isCharNumberLT :: UArray Char Bool-isCharNumberLT =- listArray ('\0', '\255')- (map (\c -> isHexDigit c || c `elem` ".xX") ['\0'..'\255'])---isSpaceLT :: UArray Char Bool-isSpaceLT =- listArray ('\0', '\255')- (map isSpace ['\0'..'\255'])--isAlphaLT :: UArray Char Bool-isAlphaLT =- listArray ('\0', '\255')- (map (\c -> isAlpha c || c == '_') ['\0'..'\255'])--isAlphaNumLT :: UArray Char Bool-isAlphaNumLT =- listArray ('\0', '\255')- (map (\c -> isAlphaNum c || c == '_' || c == '\'') ['\0'..'\255'])--isDigitLT :: UArray Char Bool-isDigitLT =- listArray ('\0', '\255')- (map isDigit ['\0'..'\255'])--isBracketLT :: UArray Char Bool-isBracketLT =- listArray ('\0', '\255')- (map (`elem` "{[()]}") ['\0'..'\255'])---{-# INLINE mkToken #-}---mkToken :: (String -> Offset -> Token) -> Offset -> DString -> Token-mkToken ctor off ds = ctor str (off - length str)- where str = DL.toList ds---mkTokenCtor :: TokenState -> String -> Offset -> Token-mkTokenCtor StateSpace = TokenOther-mkTokenCtor StateAlpha = TokenAlpha-mkTokenCtor StateDigit = TokenDigit-mkTokenCtor StateBracket = TokenBracket-mkTokenCtor StateLit1 = TokenLiteral-mkTokenCtor StateLit2 = TokenLiteral-mkTokenCtor StateOther = TokenOther---tokenizer :: Text8 -> [Token]-tokenizer xs = (\(TokenAccum ss off _ acc out) ->- DL.toList (if null (DL.toList acc) then out- else out `DL.snoc` mkToken (mkTokenCtor ss) off acc)) $ C.foldl' tokens' (TokenAccum StateSpace 0 0 DL.empty DL.empty) xs- where tokens' :: TokenAccum -> Char -> TokenAccum- tokens' (TokenAccum StateSpace off _ _ out) x =- case () of- _ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) 0 DL.empty out- | x == '\'' -> TokenAccum StateLit1 (off+1) 0 (DL.singleton x) out- | x == '"' -> TokenAccum StateLit2 (off+1) 0 (DL.singleton x) out- | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) 0 (DL.singleton x) out- | isDigitLT ! x -> TokenAccum StateDigit (off+1) 0 (DL.singleton x) out- | isBracketLT ! x -> TokenAccum StateBracket (off+1) 0 (DL.singleton x) out- | otherwise -> TokenAccum StateOther (off+1) 0 (DL.singleton x) out-- tokens' (TokenAccum StateAlpha off _ acc out) x =- case () of- _ | isAlphaNumLT ! x -> TokenAccum StateAlpha (off+1) 0 (acc `DL.snoc` x) out- | isSpaceLT ! x -> TokenAccum StateSpace (off+1) 0 DL.empty (out `DL.snoc` mkToken TokenAlpha off acc)- | isBracketLT ! x -> TokenAccum StateBracket (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenAlpha off acc)- | otherwise -> TokenAccum StateOther (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenAlpha off acc)-- tokens' (TokenAccum StateDigit off _ acc out) x =- case () of- _ | isCharNumberLT ! x -> TokenAccum StateDigit (off+1) 0 (acc `DL.snoc` x) out- | isSpaceLT ! x -> TokenAccum StateSpace (off+1) 0 DL.empty (out `DL.snoc` mkToken TokenDigit off acc)- | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenDigit off acc)- | isBracketLT ! x -> TokenAccum StateBracket (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenDigit off acc)- | otherwise -> TokenAccum StateOther (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenDigit off acc)-- tokens' (TokenAccum StateLit1 off skip acc out) x =- case () of- _ | skip > 0 -> TokenAccum StateLit1 (off+1) (skip-1) (acc `DL.snoc` x) out- | x == '\\' -> TokenAccum StateLit1 (off+1) 1 (acc `DL.snoc` x) out- | x == '\'' -> TokenAccum StateSpace (off+1) 0 DL.empty (out `DL.snoc` mkToken TokenLiteral (off+1) (acc `DL.snoc` '\''))- | otherwise -> TokenAccum StateLit1 (off+1) 0 (acc `DL.snoc` x) out-- tokens' (TokenAccum StateLit2 off skip acc out) x =- case () of- _ | skip > 0 -> TokenAccum StateLit2 (off+1) (skip-1) (acc `DL.snoc` x) out- | x == '\\' -> TokenAccum StateLit2 (off+1) 1 (acc `DL.snoc` x) out- | x == '"' -> TokenAccum StateSpace (off+1) 0 DL.empty (out `DL.snoc` mkToken TokenLiteral (off+1) (acc `DL.snoc` '"'))- | otherwise -> TokenAccum StateLit2 (off+1) 0 (acc `DL.snoc` x) out-- tokens' (TokenAccum StateBracket off _ acc out) x =- case () of- _ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) 0 DL.empty (out `DL.snoc` mkToken TokenBracket off acc)- | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)- | isDigitLT ! x -> TokenAccum StateDigit (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)- | isBracketLT ! x -> TokenAccum StateBracket (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)- | x == '\'' -> TokenAccum StateLit1 (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)- | x == '"' -> TokenAccum StateLit2 (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)- | otherwise -> TokenAccum StateOther (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)-- tokens' (TokenAccum StateOther off _ acc out) x =- case () of- _ | isSpaceLT ! x -> TokenAccum StateSpace (off+1) 0 DL.empty (out `DL.snoc` mkToken TokenOther off acc)- | isAlphaLT ! x -> TokenAccum StateAlpha (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenOther off acc)- | isDigitLT ! x -> if DL.toList acc == "."- then TokenAccum StateDigit (off+1) 0 (acc `DL.snoc` x) out- else TokenAccum StateDigit (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenOther off acc)- | isBracketLT ! x -> TokenAccum StateBracket (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenOther off acc)- | x == '\'' -> TokenAccum StateLit1 (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)- | x == '"' -> TokenAccum StateLit2 (off+1) 0 (DL.singleton x) (out `DL.snoc` mkToken TokenBracket off acc)- | otherwise -> TokenAccum StateOther (off+1) 0 (acc `DL.snoc` x) out-
− src/CGrep/Semantic/Token.hs
@@ -1,32 +0,0 @@------ Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>------ This program is free software; you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation; either version 2 of the License, or--- (at your option) any later version.------ This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the--- GNU General Public License for more details.------ You should have received a copy of the GNU General Public License--- along with this program; if not, write to the Free Software--- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.-----module CGrep.Semantic.Token (SemanticToken(..)) where---class (Show t, Ord t) => SemanticToken t where- tkIsIdentifier :: t -> Bool- tkIsString :: t -> Bool- tkIsChar :: t -> Bool- tkIsNumber :: t -> Bool- tkIsKeyword :: t -> Bool- tkEquivalent :: t -> t -> Bool- tkToString :: t -> String- tkToOffset :: t -> Int- tkToIdentif :: String -> Int -> t-
− src/CGrep/Semantic/WildCard.hs
@@ -1,220 +0,0 @@------ Copyright (c) 2013 Bonelli Nicola <bonelli@antifork.org>------ This program is free software; you can redistribute it and/or modify--- it under the terms of the GNU General Public License as published by--- the Free Software Foundation; either version 2 of the License, or--- (at your option) any later version.------ This program is distributed in the hope that it will be useful,--- but WITHOUT ANY WARRANTY; without even the implied warranty of--- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the--- GNU General Public License for more details.------ You should have received a copy of the GNU General Public License--- along with this program; if not, write to the Free Software--- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.-----module CGrep.Semantic.WildCard (WildCard(..), MultiCard,- mkWildCardFromToken,- combineMultiCard,- filterTokensWithMultiCards,- wildCardMatch,- multiCardMatch) where--import qualified Data.Map as M--import CGrep.Common-import CGrep.Distance-import CGrep.Semantic.Token--import Data.Char-import Data.List-import Options-import Util---data WildCard a =- TokenCard a |- AnyCard |- KeyWordCard |- NumberCard |- OctCard |- HexCard |- StringCard |- LiteralCard |- CharCard |- IdentifCard String- deriving (Show, Eq, Ord)----type MultiCard a = [WildCard a]---wildCardMap :: M.Map String (WildCard a)-wildCardMap = M.fromList- [- ("ANY", AnyCard ),- ("KEY", KeyWordCard ),- ("OCT", OctCard ),- ("HEX", HexCard ),- ("NUM", NumberCard ),- ("CHR", CharCard ),- ("STR", StringCard ),- ("LIT", StringCard )- ]---mkWildCardFromToken :: (SemanticToken a) => a -> WildCard a-mkWildCardFromToken t- | tkIsIdentifier t = case () of- _ | Just wc <- M.lookup str wildCardMap -> wc- | isWildCardIdentif str -> IdentifCard str- | otherwise -> TokenCard $ tkToIdentif (rmWildCardEscape str) (tkToOffset t)- where str = tkToString t-- | otherwise = TokenCard t---combineMultiCard :: (SemanticToken a) => [MultiCard a] -> [MultiCard a]-combineMultiCard (m1:r@(m2:m3:ms))- | [TokenCard b] <- m2, tkToString b == "OR" = combineMultiCard $ (m1++m3):ms- | otherwise = m1 : combineMultiCard r-combineMultiCard [m1,m2] = [m1,m2]-combineMultiCard [m1] = [m1]-combineMultiCard [] = []---filterTokensWithMultiCards :: (SemanticToken a) => Options -> [MultiCard a] -> [a] -> [a]-filterTokensWithMultiCards opt ws = filterTokensWithMultiCards' opt (spanOptionalCards ws)---filterTokensWithMultiCards' :: (SemanticToken a) => Options -> [[MultiCard a]] -> [a] -> [a]-filterTokensWithMultiCards' _ [] _ = []-filterTokensWithMultiCards' opt (g:gs) ts =- concatMap (take grpLen . (`drop` ts)) (findIndices (multiCardCompare opt g) grp) ++- filterTokensWithMultiCards' opt gs ts- where grp = spanGroup grpLen ts- grpLen = length g---spanOptionalCards :: [MultiCard a] -> [[MultiCard a]]-spanOptionalCards wc = map (`filterCardIndicies` wc') idx- where wc' = zip [0..] wc- idx = subsequences $- findIndices (\w -> case w of- [IdentifCard ('$':_)] -> True- _ -> False) wc---filterCardIndicies :: [Int] -> [(Int, MultiCard a)] -> [MultiCard a]-filterCardIndicies ns ps = map snd $ filter (\(n, _) -> n `notElem` ns) ps---multiCardCompare :: (SemanticToken a) => Options -> [MultiCard a] -> [a] -> Bool-multiCardCompare opt l r =- multiCardCompareAll ts && multiCardCheckOccurences ts- where ts = multiCardGroupCompare opt l r---isWildCardIdentif :: String -> Bool-isWildCardIdentif s =- case () of- _ | (x:y:_) <- s -> wprefix x && isNumber y- | [x] <- s -> wprefix x- | otherwise -> error "isWildCardIdentif"- where wprefix x = x == '$' || x == '_'---rmWildCardEscape :: String -> String-rmWildCardEscape ('$':xs) = xs-rmWildCardEscape ('_':xs) = xs-rmWildCardEscape xs = xs---{-# INLINE multiCardCompareAll #-}--multiCardCompareAll :: [(Bool, (MultiCard a, [String]))] -> Bool-multiCardCompareAll = all fst---{-# INLINE multiCardCheckOccurences #-}---- Note: pattern $ and _ match any token, whereas $1 $2 (_1 _2 etc.) match tokens--- that must compare equal in the respective occurrences-----multiCardCheckOccurences :: (SemanticToken a) => [(Bool, (MultiCard a, [String]))] -> Bool-multiCardCheckOccurences ts = M.foldr (\xs r -> r && all (== head xs) xs) True m- where m = M.mapWithKey (\k xs ->- case k of- [IdentifCard "_0"] -> xs- [IdentifCard "_1"] -> xs- [IdentifCard "_2"] -> xs- [IdentifCard "_3"] -> xs- [IdentifCard "_4"] -> xs- [IdentifCard "_5"] -> xs- [IdentifCard "_6"] -> xs- [IdentifCard "_7"] -> xs- [IdentifCard "_8"] -> xs- [IdentifCard "_9"] -> xs- [IdentifCard "$0"] -> xs- [IdentifCard "$1"] -> xs- [IdentifCard "$2"] -> xs- [IdentifCard "$3"] -> xs- [IdentifCard "$4"] -> xs- [IdentifCard "$5"] -> xs- [IdentifCard "$6"] -> xs- [IdentifCard "$7"] -> xs- [IdentifCard "$8"] -> xs- [IdentifCard "$9"] -> xs- _ -> []- ) $ M.fromListWith (++) (map snd ts)---multiCardGroupCompare :: (SemanticToken a) => Options -> [MultiCard a] -> [a] -> [(Bool, (MultiCard a, [String]))]-multiCardGroupCompare opt ls rs- | length rs >= length ls = zipWith (tokensZip opt) ls rs- | otherwise = [ (False, ([AnyCard], [])) ]---tokensZip :: (SemanticToken a) => Options -> MultiCard a -> a -> (Bool, (MultiCard a, [String]))-tokensZip opt l r- | multiCardMatch opt l r = (True, (l, [tkToString r]))- | otherwise = (False, ([AnyCard],[] ))---multiCardMatch :: (SemanticToken t) => Options -> MultiCard t -> t -> Bool-multiCardMatch opt m t = any (\w -> wildCardMatch opt w t) m--wildCardMatch :: (SemanticToken t) => Options -> WildCard t -> t -> Bool-wildCardMatch _ AnyCard _ = True-wildCardMatch _ (IdentifCard _) t = tkIsIdentifier t-wildCardMatch _ KeyWordCard t = tkIsKeyword t-wildCardMatch _ StringCard t = tkIsString t-wildCardMatch _ CharCard t = tkIsChar t-wildCardMatch _ LiteralCard t = tkIsString t || tkIsChar t-wildCardMatch _ NumberCard t = tkIsNumber t-wildCardMatch _ OctCard t = tkIsNumber t && case tkToString t of ('0':d: _) -> isDigit d; _ -> False-wildCardMatch _ HexCard t = tkIsNumber t && case tkToString t of ('0':'x':_) -> True; _ -> False-wildCardMatch opt (TokenCard l) r- | tkIsIdentifier l && tkIsIdentifier r =- case () of- _ | edit_dist opt -> tkToString l ~== tkToString r- | word_match opt -> tkToString l == tkToString r- | prefix_match opt -> tkToString l `isPrefixOf` tkToString r- | suffix_match opt -> tkToString l `isSuffixOf` tkToString r- | otherwise -> tkToString l `isInfixOf` tkToString r- | tkIsString l && tkIsString r =- case () of- _ | edit_dist opt -> ls ~== rs- | word_match opt -> ls == rs- | prefix_match opt -> ls `isPrefixOf` rs- | suffix_match opt -> ls `isSuffixOf` rs- | otherwise -> ls `isInfixOf` rs- where ls = rmQuote $ trim (tkToString l)- rs = rmQuote $ trim (tkToString r)- | otherwise = l `tkEquivalent` r-
src/CGrep/Strategy/BoyerMoore.hs view
@@ -40,41 +40,35 @@ search :: FilePath -> [Text8] -> ReaderT Options IO [Output]-search f ps = do+search f patterns = do - opt <- ask+ opt <- ask+ text <- liftIO $ getTargetContents f let filename = getTargetName f - text <- liftIO $ getTargetContents f- -- transform text - let text' = ignoreCase opt text-- -- put banners...-- putStrLevel1 $ "strategy : running string search on " ++ filename ++ "..."-- runSearch filename (quickSearch opt ps text') $ do-- -- context filter-- let text'' = contextFilter (getFileLang opt filename) (mkContextFilter opt) text'+ let [text''', _ , text', _] = scanr ($) text [ expandMultiline opt+ , contextFilter (getFileLang opt filename) (mkContextFilter opt)+ , ignoreCase opt+ ] - -- expand multi-line+ putStrLevel1 $ "strategy : running Boyer-Moore search on " ++ filename ++ "..." - text''' = expandMultiline opt text''+ runQuickSearch filename (quickSearch opt patterns text') $ do -- search for matching tokens - tokens = map (A.second C.unpack) $ ps >>= (\p -> map (\i -> (i,p)) (p `SC.nonOverlappingIndices` text'''))+ let tokens = map (A.second C.unpack) $ patterns >>= (\p -> map (\i -> (i,p)) (p `SC.nonOverlappingIndices` text''')) -- filter exact/partial matching tokens tokens' = if word_match opt || prefix_match opt || suffix_match opt then filter (checkToken opt text''') tokens else tokens++ -- print banners... putStrLevel2 $ "tokens : " ++ show tokens putStrLevel2 $ "tokens' : " ++ show tokens'
src/CGrep/Strategy/Cpp/Semantic.hs view
@@ -19,7 +19,7 @@ module CGrep.Strategy.Cpp.Semantic (search) where import qualified Data.ByteString.Char8 as C-import qualified CGrep.Semantic.Cpp.Token as Cpp+import qualified CGrep.Parser.Cpp.Token as Cpp import Control.Monad.Trans.Reader import Control.Monad.IO.Class@@ -32,7 +32,7 @@ import CGrep.Common import CGrep.Output -import CGrep.Semantic.WildCard+import CGrep.Parser.WildCard import Options import Debug@@ -40,61 +40,57 @@ search :: FilePath -> [Text8] -> ReaderT Options IO [Output]-search f ps = do+search f patterns = do - opt <- ask+ opt <- ask+ text <- liftIO $ getTargetContents f let filename = getTargetName f - text <- liftIO $ getTargetContents f- -- transform text - let text' = ignoreCase opt text-- filt = (mkContextFilter opt) { getFilterComment = False }+ let filt = (mkContextFilter opt) { getFilterComment = False }+ text' = ignoreCase opt text -- pre-process patterns - patterns = map (Cpp.tokenizer . contextFilter (Just Cpp) filt) ps -- [ [t1,t2,..], [t1,t2...] ]- patterns' = map (map mkWildCardFromToken) patterns -- [ [w1,w2,..], [w1,w2,..] ]- patterns'' = map (combineMultiCard . map (:[])) patterns' -- [ [m1,m2,..], [m1,m2,..] ] == [ [ [w1], [w2],..], [[w1],[w2],..]]+ patterns' = map (Cpp.tokenizer . contextFilter (Just Cpp) filt) patterns -- [ [t1,t2,..], [t1,t2...] ]+ patterns'' = map (map mkWildCardFromToken) patterns' -- [ [w1,w2,..], [w1,w2,..] ]+ patterns''' = map (combineMultiCard . map (:[])) patterns'' -- [ [m1,m2,..], [m1,m2,..] ] == [ [ [w1], [w2],..], [[w1],[w2],..]] - -- quick Search... - ps' = (mapMaybe (\x -> case x of- TokenCard (Cpp.TokenChar xs _) -> Just (rmQuote $ trim xs)- TokenCard (Cpp.TokenString xs _) -> Just (rmQuote $ trim xs)- TokenCard (Cpp.TokenIdentifier "OR" _) -> Nothing- TokenCard t -> Just (Cpp.toString t)- _ -> Nothing- ) . concat) patterns'+ -- quickSearch + identif = (mapMaybe (\x -> case x of+ TokenCard (Cpp.TokenChar xs _) -> Just (rmQuote $ trim xs)+ TokenCard (Cpp.TokenString xs _) -> Just (rmQuote $ trim xs)+ TokenCard (Cpp.TokenIdentifier "OR" _) -> Nothing+ TokenCard t -> Just (Cpp.toString t)+ _ -> Nothing+ ) . concat) patterns''+ -- put banners... putStrLevel1 $ "strategy : running C/C++ semantic search on " ++ filename ++ "..."- putStrLevel2 $ "wildcards : " ++ show patterns'- putStrLevel2 $ "multicards: " ++ show patterns''- putStrLevel2 $ "identif : " ++ show ps'-- runSearch filename (quickSearch opt (map C.pack ps') text') $ do- -- context filter-- let text'' = contextFilter (getFileLang opt filename) filt text'+ putStrLevel2 $ "wildcards : " ++ show patterns''+ putStrLevel2 $ "multicards: " ++ show patterns'''+ putStrLevel2 $ "identif : " ++ show identif - -- expand multi-line+ runQuickSearch filename (quickSearch opt (map C.pack identif) text') $ do - text''' = expandMultiline opt text''+ let [text''', _ , _] = scanr ($) text' [ expandMultiline opt+ , contextFilter (getFileLang opt filename) filt+ ] -- parse source code, get the Cpp.Token list... - tokens = Cpp.tokenizer text'''+ let tokens = Cpp.tokenizer text''' -- get matching tokens ... - tokens' = sortBy (compare `on` Cpp.toOffset) $ nub $ concatMap (\ms -> filterTokensWithMultiCards opt ms tokens) patterns''+ tokens' = sortBy (compare `on` Cpp.toOffset) $ nub $ concatMap (\ms -> filterTokensWithMultiCards opt ms tokens) patterns''' - matches = map (\t -> let n = fromIntegral (Cpp.toOffset t) in (n, Cpp.toString t)) tokens' :: [(Int, String)]+ matches = map (\t -> let n = fromIntegral (Cpp.toOffset t) in (n, Cpp.toString t)) tokens' :: [(Int, String)] putStrLevel2 $ "tokens : " ++ show tokens' putStrLevel2 $ "matches : " ++ show matches
src/CGrep/Strategy/Cpp/Tokenizer.hs view
@@ -19,7 +19,7 @@ module CGrep.Strategy.Cpp.Tokenizer (search) where import qualified Data.ByteString.Char8 as C-import qualified CGrep.Semantic.Cpp.Token as Cpp+import qualified CGrep.Parser.Cpp.Token as Cpp import Control.Monad.Trans.Reader import Control.Monad.IO.Class@@ -40,33 +40,29 @@ search f ps = do opt <- ask+ text <- liftIO $ getTargetContents f let filename = getTargetName f - text <- liftIO $ getTargetContents f- -- transform text - let text' = ignoreCase opt text- filt = (mkContextFilter opt) { getFilterComment = False }+ let filt = (mkContextFilter opt) { getFilterComment = False } - putStrLevel1 $ "strategy : running C/C++ token search on " ++ filename ++ "..."+ [text''', _ , text', _] = scanr ($) text [ expandMultiline opt+ , contextFilter (getFileLang opt filename) filt+ , ignoreCase opt+ ] - --quickSearch ... - runSearch filename (quickSearch opt ps text') $ do-- -- context filter-- let text'' = contextFilter (getFileLang opt filename) filt text'+ putStrLevel1 $ "strategy : running C/C++ token search on " ++ filename ++ "..." - -- expand multi-line+ --quickSearch ... - text''' = expandMultiline opt text''+ runQuickSearch filename (quickSearch opt ps text') $ do -- parse source code, get the Cpp.Token list... - tokens = Cpp.tokenizer text'''+ let tokens = Cpp.tokenizer text''' -- context-filterting...
src/CGrep/Strategy/Generic/Semantic.hs view
@@ -19,15 +19,15 @@ module CGrep.Strategy.Generic.Semantic (search) where import qualified Data.ByteString.Char8 as C-import qualified CGrep.Semantic.Generic.Token as Generic+import qualified CGrep.Parser.Generic.Token as Generic import CGrep.Filter import CGrep.Lang import CGrep.Common import CGrep.Output -import CGrep.Semantic.Token-import CGrep.Semantic.WildCard+import CGrep.Parser.Token+import CGrep.Parser.WildCard import Control.Monad.Trans.Reader import Control.Monad.IO.Class@@ -45,11 +45,10 @@ search f ps = do opt <- ask+ text <- liftIO $ getTargetContents f let filename = getTargetName f - text <- liftIO $ getTargetContents f- -- transform text let text' = ignoreCase opt text@@ -59,8 +58,8 @@ -- pre-process patterns patterns = map (Generic.tokenizer . contextFilter (getFileLang opt filename) filt) ps -- [ [t1,t2,..], [t1,t2...] ]- patterns' = map (map mkWildCardFromToken) patterns -- [ [w1,w2,..], [w1,w2,..] ]- patterns'' = map (combineMultiCard . map (:[])) patterns' -- [ [m1,m2,..], [m1,m2,..] ] == [[[w1], [w2],..], [[w1],[w2],..]]+ patterns' = map (map mkWildCardFromToken) patterns -- [ [w1,w2,..], [w1,w2,..] ]+ patterns'' = map (combineMultiCard . map (:[])) patterns' -- [ [m1,m2,..], [m1,m2,..] ] == [[[w1], [w2],..], [[w1],[w2],..]] -- quickSearch ... @@ -79,7 +78,7 @@ putStrLevel2 $ "identif : " ++ show ps' - runSearch filename (quickSearch opt (map C.pack ps') text') $ do+ runQuickSearch filename (quickSearch opt (map C.pack ps') text') $ do -- context filter
src/CGrep/Strategy/Levenshtein.hs view
@@ -35,34 +35,34 @@ search :: FilePath -> [Text8] -> ReaderT Options IO [Output]-search f ps = do+search f patterns = do opt <- ask+ text <- liftIO $ getTargetContents f let filename = getTargetName f - text <- liftIO $ getTargetContents f- -- transform text - let text' = ignoreCase opt . contextFilter (getFileLang opt filename) (mkContextFilter opt) $ text-- text'' = expandMultiline opt text'+ let [text''', _ , _ , _] = scanr ($) text [ expandMultiline opt+ , contextFilter (getFileLang opt filename) (mkContextFilter opt)+ , ignoreCase opt+ ] -- parse source code, get the Cpp.Token list... - tokens' = tokenizer text''+ tokens' = tokenizer text''' -- filter tokens... - patterns = map C.unpack ps+ patterns' = map C.unpack patterns - matches = filter (\t -> any (\p -> p ~== snd t) patterns) tokens'+ matches = filter (\t -> any (\p -> p ~== snd t) patterns') tokens' putStrLevel1 $ "strategy : running edit-distance (Levenshtein) search on " ++ filename ++ "..." putStrLevel2 $ "tokens : " ++ show tokens' putStrLevel2 $ "matches : " ++ show matches- putStrLevel3 $ "---\n" ++ C.unpack text'' ++ "\n---"+ putStrLevel3 $ "---\n" ++ C.unpack text''' ++ "\n---" - mkOutput filename text text'' matches+ mkOutput filename text text''' matches
src/CGrep/Strategy/Regex.hs view
@@ -37,30 +37,24 @@ search :: FilePath -> [Text8] -> ReaderT Options IO [Output]-search f ps = do+search f patterns = do opt <- ask+ text <- liftIO $ getTargetContents f let filename = getTargetName f - text <- liftIO $ getTargetContents f- -- transform text - let text' = expandMultiline opt . ignoreCase opt $ text-- -- context filter-- text'' = contextFilter (getFileLang opt filename) (mkContextFilter opt) text'-- -- expand multi-line-- text''' = expandMultiline opt text''+ let [text''', _ , _ , _] = scanr ($) text [ expandMultiline opt+ , contextFilter (getFileLang opt filename) (mkContextFilter opt)+ , ignoreCase opt+ ] -- search for matching tokens tokens = map (\(str, (off,_)) -> (off, C.unpack str) ) $- concatMap elems $ ps >>= (\p -> elems (getAllTextMatches $ text''' =~ p :: (Array Int) (MatchText Text8)))+ concatMap elems $ patterns >>= (\p -> elems (getAllTextMatches $ text''' =~ p :: (Array Int) (MatchText Text8))) putStrLevel1 $ "strategy : running regex search on " ++ filename ++ "..." putStrLevel2 $ "tokens : " ++ show tokens
src/Config.hs view
@@ -33,14 +33,14 @@ cgreprc = "cgreprc" version :: String-version = "6.5.6"+version = "6.5.8" data Config = Config- { configLanguages :: [Lang]- , configPruneDirs :: [String]- , configAutoColor :: Bool- } deriving (Show, Read)+ { configLanguages :: [Lang]+ , configPruneDirs :: [String]+ , configAutoColor :: Bool+ } deriving (Show, Read) @@ -52,8 +52,10 @@ getConfig :: IO Config getConfig = do home <- getHomeDirectory- confs <- filterM doesFileExist ["." ++ cgreprc, home </> "." ++ cgreprc, "/etc" </> cgreprc]- if notNull confs then liftM dropComments (readFile (head confs)) >>= \xs ->- return (prettyRead xs "Config error" :: Config)- else return $ Config [] [] False+ confs <- filterM doesFileExist [cgreprc, "." ++ cgreprc, home </> "." ++ cgreprc, "/etc" </> cgreprc]+ if notNull confs+ then liftM dropComments (readFile (head confs)) >>= \xs ->+ return (prettyRead xs "Config error" :: Config)+ else return $ Config [] [] False+
src/Main.hs view
@@ -127,7 +127,7 @@ [] -> atomically $ writeTChan out_chan [] xs -> void ((if asynch opts then flip mapConcurrently else forM) xs $ \x -> do- out <- fmap (take (max_count opts)) (runReaderT (cgrepDispatch x patterns) (sanitizeOptions x opts))+ out <- fmap (take (max_count opts)) (runReaderT (runCgrep x patterns) (sanitizeOptions x opts)) unless (null out) $ atomically $ writeTChan out_chan out) ) (\e -> let msg = show (e :: SomeException) in hPutStrLn stderr (showFile opts (getTargetName (head fs)) ++ ": exception: " ++ if length msg > 80 then take 80 msg ++ "..." else msg))