diff --git a/benchmark/benchmark.hs b/benchmark/benchmark.hs --- a/benchmark/benchmark.hs +++ b/benchmark/benchmark.hs @@ -5,7 +5,7 @@ import System.FilePath import Data.Text (Text) import qualified Data.Text as Text -import System.Directory +-- import System.Directory main :: IO () main = do @@ -17,8 +17,9 @@ let format = drop 1 $ takeExtension fp return (Text.pack format, Text.pack contents) cases <- mapM getCase inputs - xmlfiles <- filter (\x -> takeExtension x == ".xml") <$> - getDirectoryContents "xml" + -- xmlfiles <- filter (\x -> takeExtension x == ".xml") <$> + -- getDirectoryContents "xml" + let xmlfiles = ["haskell.xml"] defaultMainWith defaultConfig{ timeLimit = 10.0 } $ parseBench xmlfiles : map testBench cases diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,5 +1,16 @@ # Revision history for skylighting +## 0.3.1 -- 2017-02-28 + + * Use handwritten parser for Float instead of regex. Fixes + jgm/highlighting-kate#57 (again). + * Added float parsing tests. + * Use parsec parsers, not regex, for CStringChar and CChar. + * Rewrote Int, Hex, Oct, CStringChar, CCHar parsers with parsec + instead of regex. This speeds things up. + * Don't include leading + in Int, Hex, Oct parsers. That gives + bad results for things like `i+1`. + ## 0.3 -- 2017-02-19 * Store literal binary-encoded representations of the Syntax diff --git a/skylighting.cabal b/skylighting.cabal --- a/skylighting.cabal +++ b/skylighting.cabal @@ -1,5 +1,5 @@ name: skylighting -version: 0.3 +version: 0.3.1 synopsis: syntax highlighting library description: Skylighting is a syntax highlighting library with support for over one hundred languages. It derives @@ -233,6 +233,7 @@ filepath, aeson, case-insensitive, + attoparsec, utf8-string, hxt, safe, diff --git a/src/Skylighting/Tokenizer.hs b/src/Skylighting/Tokenizer.hs --- a/src/Skylighting/Tokenizer.hs +++ b/src/Skylighting/Tokenizer.hs @@ -20,6 +20,7 @@ import qualified Data.Text as Text import Data.Text.Encoding (decodeUtf8', encodeUtf8) import qualified Data.ByteString.UTF8 as UTF8 +import qualified Data.Attoparsec.ByteString.Char8 as A import Debug.Trace import Skylighting.Regex import Skylighting.Types @@ -214,13 +215,12 @@ AnyChar cs -> withAttr attr $ anyChar cs inp RangeDetect c d -> withAttr attr $ rangeDetect c d inp RegExpr re -> withAttr attr $ regExpr (rDynamic rule) re inp - Int -> withAttr attr $ regExpr False integerRegex inp - HlCOct -> withAttr attr $ regExpr False octRegex inp - HlCHex -> withAttr attr $ regExpr False hexRegex inp - HlCStringChar -> withAttr attr $ - regExpr False hlCStringCharRegex inp - HlCChar -> withAttr attr $ regExpr False hlCCharRegex inp - Float -> withAttr attr $ regExpr False floatRegex inp + Int -> withAttr attr $ parseInt inp + HlCOct -> withAttr attr $ parseOct inp + HlCHex -> withAttr attr $ parseHex inp + HlCStringChar -> withAttr attr $ parseCStringChar inp + HlCChar -> withAttr attr $ parseCChar inp + Float -> withAttr attr $ parseFloat inp Keyword kwattr kws -> withAttr attr $ keyword kwattr kws inp StringDetect s -> withAttr attr $ @@ -269,22 +269,6 @@ then return Nothing else return $ Just (tt, res) -hlCStringCharRegex :: RE -hlCStringCharRegex = RE{ - reString = reHlCStringChar - , reCaseSensitive = False - } - -reHlCStringChar :: ByteString -reHlCStringChar = "\\\\(?:[abefnrtv\"'?\\\\]|[xX][a-fA-F0-9]+|0[0-7]+)" - -hlCCharRegex :: RE -hlCCharRegex = RE{ - reString = reStr - , reCaseSensitive = False - } - where reStr = "'(?:" <> reHlCStringChar <> "|[^'\\\\])'" - {- -- Try a tokenizer and return to original state if it fails. -- This is used when one tokenizer calls another. @@ -472,8 +456,12 @@ -- TODO is this right? isWordBoundary :: Char -> Char -> Bool isWordBoundary c d = - (isAlphaNum c && not (isAlphaNum d)) || (isAlphaNum d && not (isAlphaNum c)) + (isAlphaNum c && not (isAlphaNum d)) + || (isAlphaNum d && not (isAlphaNum c)) + || (isSpace d && not (isSpace c)) + || (isSpace c && not (isSpace d)) + decodeBS :: ByteString -> TokenizerM Text decodeBS bs = case decodeUtf8' bs of Left _ -> throwError ("ByteString " ++ @@ -543,31 +531,110 @@ (t, Text.concat (x : map snd matches)) : normalizeHighlighting rest where (matches, rest) = span (\(z,_) -> z == t) xs -integerRegex :: RE -integerRegex = RE{ - reString = intReStr - , reCaseSensitive = False - } - where intReStr = "\\b[-+]?(0[Xx][0-9A-Fa-f]+|0[Oo][0-7]+|[0-9]+)\\b" +parseCStringChar :: ByteString -> TokenizerM Text +parseCStringChar inp = do + case A.parseOnly (A.match pCStringChar) inp of + Left _ -> mzero + Right (r,_) -> takeChars (BS.length r) -- assumes ascii -floatRegex :: RE -floatRegex = RE{ - reString = floatReStr - , reCaseSensitive = False - } - where floatReStr = "\\b[-+]?(([0-9]+\\.[0-9]*|[0-9]*\\.[0-9]+)([Ee][-+]?[0-9]+)?|[0-9]+[Ee][-+]?[0-9]+)\\b" +pCStringChar :: A.Parser () +pCStringChar = do + _ <- A.char '\\' + next <- A.anyChar + case next of + c | c == 'x' || c == 'X' -> () <$ A.takeWhile1 (A.inClass "0-9a-fA-F") + | c == '0' -> () <$ A.takeWhile1 (A.inClass "0-7") + | A.inClass "abefnrtv\"'?\\" c -> return () + | otherwise -> mzero -octRegex :: RE -octRegex = RE{ - reString = octRegexStr - , reCaseSensitive = False - } - where octRegexStr = "\\b[-+]?0[Oo][0-7]+\\b" +parseCChar :: ByteString -> TokenizerM Text +parseCChar inp = do + case A.parseOnly (A.match pCChar) inp of + Left _ -> mzero + Right (r,_) -> takeChars (BS.length r) -- assumes ascii -hexRegex :: RE -hexRegex = RE{ - reString = hexRegexStr - , reCaseSensitive = False - } - where hexRegexStr = "\\b[-+]?0[Xx][0-9A-Fa-f]+\\b" +pCChar :: A.Parser () +pCChar = do + () <$ A.char '\'' + pCStringChar <|> () <$ A.satisfy (\c -> c /= '\'' && c /= '\\') + () <$ A.char '\'' + +parseInt :: ByteString -> TokenizerM Text +parseInt inp = do + wordBoundary inp + case A.parseOnly (A.match (pHex <|> pOct <|> pDec)) inp of + Left _ -> mzero + Right (r,_) -> takeChars (BS.length r) -- assumes ascii + +pDec :: A.Parser () +pDec = do + mbMinus + _ <- A.takeWhile1 (A.inClass "0-9") + guardWordBoundary + +parseOct :: ByteString -> TokenizerM Text +parseOct inp = do + wordBoundary inp + case A.parseOnly (A.match pHex) inp of + Left _ -> mzero + Right (r,_) -> takeChars (BS.length r) -- assumes ascii + +pOct :: A.Parser () +pOct = do + mbMinus + _ <- A.char '0' + _ <- A.satisfy (A.inClass "Oo") + _ <- A.takeWhile1 (A.inClass "0-7") + guardWordBoundary + +parseHex :: ByteString -> TokenizerM Text +parseHex inp = do + wordBoundary inp + case A.parseOnly (A.match pHex) inp of + Left _ -> mzero + Right (r,_) -> takeChars (BS.length r) -- assumes ascii + +pHex :: A.Parser () +pHex = do + mbMinus + _ <- A.char '0' + _ <- A.satisfy (A.inClass "Xx") + _ <- A.takeWhile1 (A.inClass "0-9a-fA-F") + guardWordBoundary + +guardWordBoundary :: A.Parser () +guardWordBoundary = do + mbw <- A.peekChar + case mbw of + Just c -> guard $ isWordBoundary '0' c + Nothing -> return () + +mbMinus :: A.Parser () +mbMinus = (() <$ A.char '-') <|> return () + +mbPlusMinus :: A.Parser () +mbPlusMinus = () <$ A.satisfy (A.inClass "+-") <|> return () + +parseFloat :: ByteString -> TokenizerM Text +parseFloat inp = do + wordBoundary inp + case A.parseOnly (A.match pFloat) inp of + Left _ -> mzero + Right (r,_) -> takeChars (BS.length r) -- assumes all ascii + where pFloat :: A.Parser () + pFloat = do + let digits = A.takeWhile1 (A.inClass "0-9") + mbPlusMinus + before <- A.option False $ True <$ digits + dot <- A.option False $ True <$ A.satisfy (A.inClass ".") + after <- A.option False $ True <$ digits + e <- A.option False $ True <$ (A.satisfy (A.inClass "Ee") >> + mbPlusMinus >> digits) + mbnext <- A.peekChar + case mbnext of + Nothing -> return () + Just c -> guard (not $ A.inClass "." c) + guard $ (before && not dot && e) -- 5e2 + || (before && dot && (after || not e)) -- 5.2e2 or 5.2 or 5. + || (not before && dot && after) -- .23 or .23e2 diff --git a/test/expected/abc.javascript.native b/test/expected/abc.javascript.native --- a/test/expected/abc.javascript.native +++ b/test/expected/abc.javascript.native @@ -100,8 +100,7 @@ , ( NormalTok , " (index " ) , ( OperatorTok , "!==" ) , ( NormalTok , " " ) - , ( OperatorTok , "-" ) - , ( DecValTok , "1" ) + , ( DecValTok , "-1" ) , ( NormalTok , ") " ) , ( OperatorTok , "{" ) ] diff --git a/test/test-skylighting.hs b/test/test-skylighting.hs --- a/test/test-skylighting.hs +++ b/test/test-skylighting.hs @@ -75,7 +75,9 @@ map (noDropTest randomText) syntaxes , testGroup "Regression tests" $ let perl = maybe (error "could not find Perl syntax") id - (lookupSyntax "Perl" defaultSyntaxMap) in + (lookupSyntax "Perl" defaultSyntaxMap) + cpp = maybe (error "could not find CPP syntax") id + (lookupSyntax "cpp" defaultSyntaxMap) in [ testCase "perl NUL case" $ Right [[(KeywordTok,"s\NUL") ,(OtherTok,"b") @@ -115,6 +117,22 @@ ] ] @=? tokenize defConfig perl "my $foo = q/bar/;\nmy $baz = 'quux';\n" + , testCase "cpp floats" $ Right + [ [ ( FloatTok , "0.1f" ) ] + , [ ( FloatTok , "1.0f" ) ] + , [ ( FloatTok , "-0.1f" ) ] + , [ ( FloatTok , "-1.0F" ) ] + , [ ( FloatTok , "-1.0L" ) ] + , [ ( FloatTok , "1e3" ) ] + , [ ( FloatTok , "-15e+3" ) ] + , [ ( FloatTok , "0.f" ) ] + , [ ( FloatTok , "1.F" ) ] + , [ ( DecValTok , "1" ) + , ( NormalTok ,".E" ) + , ( DecValTok , "3" ) + ] + ] @=? tokenize defConfig cpp + "0.1f\n1.0f\n-0.1f\n-1.0F\n-1.0L\n1e3\n-15e+3\n0.f\n1.F\n1.E3" ] ]