sexp-grammar 2.0.2 → 2.1.0
raw patch · 5 files changed
+100/−112 lines, 5 filesdep ~prettyprinterdep ~semigroupsPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: prettyprinter, semigroups
API changes (from Hackage documentation)
Files
- sexp-grammar.cabal +1/−2
- src/Language/Sexp/Lexer.x +85/−25
- src/Language/Sexp/LexerInterface.hs +0/−81
- src/Language/Sexp/Parser.y +10/−2
- src/Language/Sexp/Token.hs +4/−2
sexp-grammar.cabal view
@@ -1,5 +1,5 @@ name: sexp-grammar-version: 2.0.2+version: 2.1.0 license: BSD3 license-file: LICENSE author: Eugene Smolanka, Sergey Vinokurov@@ -39,7 +39,6 @@ other-modules: Language.Sexp.Encode Language.Sexp.Lexer- Language.Sexp.LexerInterface Language.Sexp.Parser Language.Sexp.Pretty Language.Sexp.Token
src/Language/Sexp/Lexer.x view
@@ -13,16 +13,18 @@ ) where import Data.Bifunctor+import qualified Data.ByteString.Lazy as BLW import Data.ByteString.Lazy.Char8 (ByteString)-import qualified Data.ByteString.Lazy.UTF8 as UTF8 import qualified Data.ByteString.Lazy.Char8 as BL+import qualified Data.ByteString.Lazy.UTF8 as UTF8+import Data.Int+import Data.Scientific (Scientific) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Encoding (decodeUtf8) import Data.Text.Read-import Data.Scientific (Scientific)+import Data.Word -import Language.Sexp.LexerInterface import Language.Sexp.Token import Language.Sexp.Types (Position (..), LocatedBy (..)) @@ -71,12 +73,20 @@ @symbol { TokSymbol `via` decode } \" @string* \" { TokString `via` readString } -. { TokUnknown `via` BL.head }- { -type AlexAction = LineCol -> ByteString -> LocatedBy LineCol Token+----------------------------------------------------------------------+-- Actions +just :: Token -> AlexAction+just tok _ = tok++via :: (a -> Token) -> (ByteString -> a) -> AlexAction+via ftok f = ftok . f++----------------------------------------------------------------------+-- Decoders+ readString :: ByteString -> T.Text readString = TL.toStrict . unescape . TL.tail . TL.init . decodeUtf8 @@ -86,34 +96,84 @@ decode :: ByteString -> T.Text decode = TL.toStrict . decodeUtf8 -just :: Token -> AlexAction-just tok pos _ =- pos :< tok+----------------------------------------------------------------------+-- Entry point -via :: (a -> Token) -> (ByteString -> a) -> AlexAction-via ftok f pos str =- (pos :<) . ftok . f $ str+lexSexp :: Position -> ByteString -> [LocatedBy Position Token]+lexSexp (Position fn line1 col1) =+ map (bimap fixPos id) . alexScanTokens . mkAlexInput (LineCol line1 col1)+ where+ fixPos (LineCol l c) = Position fn l c +----------------------------------------------------------------------+-- Machinery++type AlexAction = ByteString -> Token+ alexScanTokens :: AlexInput -> [LocatedBy LineCol Token] alexScanTokens input = case alexScan input defaultCode of- AlexEOF -> []- AlexError (AlexInput {aiInput, aiLineCol = LineCol line col}) ->- error $ "Lexical error at line " ++ show line ++ " column " ++ show col ++- ". Remaining input: " ++ show (UTF8.take 200 aiInput)- AlexSkip input _ -> alexScanTokens input+ AlexEOF ->+ [aiLineCol input :< TokEOF]+ AlexError (AlexInput {aiInput, aiLineCol}) ->+ let rest = T.takeWhile (/= '\n') $ decode $ UTF8.take 100 aiInput+ in [aiLineCol :< (TokUnknown rest)]+ AlexSkip input _ ->+ alexScanTokens input AlexToken input' tokLen action ->- action inputPosn inputText : alexScanTokens input'- where- inputPosn = aiLineCol input- inputText = UTF8.take (fromIntegral tokLen) (aiInput input)+ let inputText = UTF8.take (fromIntegral tokLen) (aiInput input)+ in (aiLineCol input :< action inputText) : alexScanTokens input' where defaultCode :: Int defaultCode = 0 -lexSexp :: Position -> ByteString -> [LocatedBy Position Token]-lexSexp (Position fn line1 col1) =- map (bimap fixPos id) . alexScanTokens . mkAlexInput (LineCol line1 col1)+data LineCol = LineCol {-# UNPACK #-} !Int {-# UNPACK #-} !Int++columnsInTab :: Int+columnsInTab = 8++advanceLineCol :: Char -> LineCol -> LineCol+advanceLineCol '\n' (LineCol line _) = LineCol (line + 1) 1+advanceLineCol '\t' (LineCol line col) = LineCol line (((col + columnsInTab - 1) `div` columnsInTab) * columnsInTab + 1)+advanceLineCol _ (LineCol line col) = LineCol line (col + 1)++data AlexInput = AlexInput+ { aiInput :: ByteString+ , aiPrevChar :: {-# UNPACK #-} !Char+ , aiBytesLeft :: {-# UNPACK #-} !Int64+ , aiLineCol :: !LineCol+ }++mkAlexInput :: LineCol -> ByteString -> AlexInput+mkAlexInput initPos source = AlexInput+ { aiInput = source+ , aiPrevChar = '\n'+ , aiBytesLeft = 0+ , aiLineCol = initPos+ }++alexNextChar :: AlexInput -> Maybe AlexInput+alexNextChar input+ | aiBytesLeft input > 1 = Just $ input { aiBytesLeft = aiBytesLeft input - 1 }+ | otherwise = case UTF8.decode (aiInput input) of+ Just (c, n) -> Just $ input+ { aiPrevChar = c+ , aiLineCol = advanceLineCol c (aiLineCol input)+ , aiBytesLeft = n+ }+ Nothing -> Nothing++-- Alex interface - functions used by Alex+alexInputPrevChar :: AlexInput -> Char+alexInputPrevChar = aiPrevChar++alexGetByte :: AlexInput -> Maybe (Word8, AlexInput)+alexGetByte input =+ alexNextChar input >>= getByte where- fixPos (LineCol l c) = Position fn l c+ getByte :: AlexInput -> Maybe (Word8, AlexInput)+ getByte input =+ case BLW.uncons (aiInput input) of+ Just (w, rest) -> Just (w, input { aiInput = rest })+ Nothing -> Nothing }
− src/Language/Sexp/LexerInterface.hs
@@ -1,81 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE OverloadedStrings #-}--module Language.Sexp.LexerInterface- ( LineCol(..)- , AlexInput(..)- , mkAlexInput- -- Alex interfare- , alexInputPrevChar- , alexGetByte- ) where--import Data.Int-import Data.ByteString.Lazy (ByteString, uncons)-import Data.ByteString.Lazy.UTF8 (decode)-import Data.Word (Word8)--data LineCol = LineCol {-# UNPACK #-} !Int {-# UNPACK #-} !Int--columnsInTab :: Int-columnsInTab = 8--advanceLineCol :: Char -> LineCol -> LineCol-advanceLineCol '\n' (LineCol line _) = LineCol (line + 1) 0-advanceLineCol '\t' (LineCol line col) = LineCol line (((col + columnsInTab - 1) `div` columnsInTab) * columnsInTab + 1)-advanceLineCol _ (LineCol line col) = LineCol line (col + 1)--data AlexInput = AlexInput- { aiInput :: ByteString- , aiPrevChar :: {-# UNPACK #-} !Char- , aiCurChar :: {-# UNPACK #-} !Char- , aiBytesLeft :: {-# UNPACK #-} !Int64- , aiLineCol :: !LineCol- }--mkAlexInput :: LineCol -> ByteString -> AlexInput-mkAlexInput initPos source = alexNextChar $ AlexInput- { aiInput = source- , aiPrevChar = '\n'- , aiCurChar = '\n'- , aiBytesLeft = 0- , aiLineCol = initPos- }--alexNextChar :: AlexInput -> AlexInput-alexNextChar input =- case decode (aiInput input) of- Just (c, n) -> input- { aiPrevChar = aiCurChar input- , aiCurChar = c- , aiBytesLeft = n- }- Nothing -> input- { aiPrevChar = aiCurChar input- , aiCurChar = '\n'- , aiBytesLeft = 0- }--alexPropagatePos :: AlexInput -> AlexInput-alexPropagatePos input =- input { aiLineCol = advanceLineCol (aiPrevChar input) (aiLineCol input) }---- Alex interface - functions usedby Alex-alexInputPrevChar :: AlexInput -> Char-alexInputPrevChar = aiPrevChar--alexGetByte :: AlexInput -> Maybe (Word8, AlexInput)-alexGetByte input- | aiBytesLeft input == 0 = go . alexPropagatePos . alexNextChar $ input- | otherwise = go input- where- go :: AlexInput -> Maybe (Word8, AlexInput)- go input =- case uncons (aiInput input) of- Just (w, rest) -> Just (w, input- { aiBytesLeft = aiBytesLeft input - 1- , aiInput = rest- })- Nothing -> Nothing-
src/Language/Sexp/Parser.y view
@@ -25,8 +25,8 @@ import Language.Sexp.Types } -%name parseSexp_ Sexp-%name parseSexps_ Sexps+%name parseSexp_ Sexp_+%name parseSexps_ Sexps_ %error { parseError } %tokentype { LocatedBy Position Token } %monad { Either String }@@ -43,10 +43,18 @@ NUMBER { _ :< (TokNumber _) } STRING { _ :< (TokString _) } + EOF { _ :< TokEOF }+ %% +Sexps_ :: { [Sexp] }+ : Sexps EOF { $1 }+ Sexps :: { [Sexp] } : list(Sexp) { $1 }++Sexp_ :: { Sexp }+ : Sexp EOF { $1 } Sexp :: { Sexp } : Atom { AtomF @@ $1 }
src/Language/Sexp/Token.hs view
@@ -30,7 +30,8 @@ | TokNumber { getNumber :: !Scientific } -- 42.0, -1.0, 3.14, -1e10 | TokString { getString :: !Text } -- "foo", "", "hello world" | TokSymbol { getSymbol :: !Text } -- foo, bar- | TokUnknown { getUnknown :: !Char } -- for unknown lexemes+ | TokUnknown { getUnknown :: !Text } -- for unknown lexemes+ | TokEOF deriving (Show, Eq) instance Pretty Token where@@ -44,7 +45,8 @@ pretty (TokSymbol s) = "symbol" <+> squotes (pretty s) <> squote pretty (TokNumber n) = "number" <+> pretty (show n) pretty (TokString s) = "string" <+> pretty (show s)- pretty (TokUnknown u) = "unrecognized" <+> pretty (show u)+ pretty (TokUnknown u) = "unrecognized" <+> pretty u <> "..."+ pretty TokEOF = "end of file" newtype DText = DText (TL.Text -> TL.Text)