tlex (empty) → 0.1.0.0
raw patch · 13 files changed
+621/−0 lines, 13 filesdep +QuickCheckdep +basedep +containersbuild-type:Customsetup-changed
Dependencies added: QuickCheck, base, containers, doctest, hspec, tlex, tlex-core
Files
- CHANGELOG.md +3/−0
- LICENSE +5/−0
- README.md +113/−0
- Setup.hs +6/−0
- src/Language/Lexer/Tlex.hs +25/−0
- src/Language/Lexer/Tlex/Data/InputString.hs +48/−0
- src/Language/Lexer/Tlex/Pipeline/Dfa2Runner.hs +46/−0
- src/Language/Lexer/Tlex/Pipeline/Scanner2Nfa.hs +53/−0
- src/Language/Lexer/Tlex/Runner.hs +69/−0
- src/Language/Lexer/Tlex/Syntax.hs +76/−0
- test/doctest/Doctest.hs +21/−0
- test/spec/HSpecDriver.hs +1/−0
- tlex.cabal +155/−0
+ CHANGELOG.md view
@@ -0,0 +1,3 @@+## 0.1.0.0 -- 2021-01-XX++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,5 @@+Apache-2.0 OR MPL-2.0++---++See https://github.com/mizunashi-mana/tlex/blob/master/LICENSE
+ README.md view
@@ -0,0 +1,113 @@+# Tlex: A Generator for Lexical Analysers++## Installation++Add dependencies on `package.cabal`:++```+build-depends:+ base,+ bytestring,+ tlex, -- main+ tlex-encoding, -- for utf8 parsing+ tlex-th, -- for outputing lexer with Template Haskell+ charset,+ template-haskell,+```++## Usage++Setup:++```haskell+import qualified Data.CharSet as CharSet+import qualified Data.Word as Word+import qualified Language.Haskell.TH as TH+import qualified Language.Lexer.Tlex as Tlex+import qualified Language.Lexer.Tlex.Plugin.Encoding as TlexEnc+import qualified Language.Lexer.Tlex.Plugin.TH as TlexTH+++type LexerState = ()+type LexerAction = [LexerCodeUnit] -> Token+type LexerCodeUnit = Word.Word8++type ScannerBuilder = TlexTH.THScannerBuilder LexerState LexerCodeUnit LexerAction+type Pattern = Tlex.Pattern LexerCodeUnit++rule :: Pattern -> TH.Q (TH.TExp LexerAction) -> ScannerBuilder ()+rule = TlexTH.thLexRule [()]+```++Setup `charSetP`:++```haskell+charSetP :: CharSet.CharSet -> Pattern+charSetP cs = TlexEnc.charSetP TlexEnc.charSetPUtf8 cs++chP :: Char -> Pattern+chP c = TlexEnc.chP TlexEnc.charSetPUtf8 c+```++Write lexer rules:++```haskell+buildLexer :: TH.Q [TH.Dec]+buildLexer = do+ lexer <- TlexTH.buildTHScannerWithReify lexerRules+ TlexTH.outputScanner lexer++data Token+ = TokWhiteSpace [LexerCodeUnit]+ | TokSmallAlpha [LexerCodeUnit]+ | TokLargeAlpha [LexerCodeUnit]+ | TokDigit [LexerCodeUnit]++lexerRules :: ScannerBuilder ()+lexerRules = do+ rule (Tlex.someP whitecharP) [||TokWhiteSpace||]+ rule (charSetP $ CharSet.range 'a' 'z') [||TokSmallAlpha||]+ rule (charSetP $ CharSet.range 'A' 'Z') [||TokLargeAlpha||]+ rule (charSetP $ CharSet.range '0' '9') [||TokDigit||]++whitecharP = Tlex.orP+ [ chP ' '+ , '\t'+ , '\n'+ , '\r'+ ]+```++Build lexer:++```haskell+$(Lexer.Rules.buildLexer)++newtype InputByteString a = InputByteString+ { unInputByteString :: ByteString -> Int -> (a, Int)+ }+ deriving (Functor, Applicative, Monad)+ via (ReaderT ByteString (State Int))++runInputByteString :: InputByteString a -> ByteString -> (a, Int)+runInputByteString (InputByteString runner) input = runner input 0++instance TlexContext Int Word8 InputByteString where+ tlexGetInputPart = InputString $ \bs i -> (bs `indexMaybe` i, i)+ tlexGetMark = InputByteString $ \bs i -> (i, i)++lexByteString :: ByteString.ByteString -> Maybe [ByteString.ByteString]+lexByteString s0 = go s0 id where+ go s acc = case runInputByteString (tlexScan ()) s of+ (TlexEndOfInput, _) -> Just $ acc []+ (TlexError, _) -> Nothing+ (TlexAccepted n act, _) ->+ let (consumed, rest) = splitAt n s+ token = act consumed+ in go rest $ \n -> acc act:n+```++## Examples++* Small language: https://github.com/mizunashi-mana/tlex/tree/master/example/small-lang+* Haskell2010: https://github.com/mizunashi-mana/tlex/tree/master/example/haskell2010
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main where++import Distribution.Extra.Doctest (defaultMainWithDoctests)++main :: IO ()+main = defaultMainWithDoctests "doctest"
+ src/Language/Lexer/Tlex.hs view
@@ -0,0 +1,25 @@+module Language.Lexer.Tlex (+ module Language.Lexer.Tlex.Syntax,+ module Language.Lexer.Tlex.Runner,+ module Language.Lexer.Tlex.Data.InputString,+ buildRunner,+) where++import Language.Lexer.Tlex.Data.InputString+import Language.Lexer.Tlex.Prelude+import Language.Lexer.Tlex.Runner+import Language.Lexer.Tlex.Syntax++import qualified Language.Lexer.Tlex.Machine.NFA as NFA+import qualified Language.Lexer.Tlex.Pipeline.Dfa2Runner as TlexPipeline+import qualified Language.Lexer.Tlex.Pipeline.MinDfa as TlexPipeline+import qualified Language.Lexer.Tlex.Pipeline.Nfa2Dfa as TlexPipeline+import qualified Language.Lexer.Tlex.Pipeline.Scanner2Nfa as TlexPipeline+++buildRunner :: Enum e => Scanner e a -> Runner e a+buildRunner scanner =+ let nfa = NFA.buildNFA do TlexPipeline.scanner2Nfa scanner+ dfa = TlexPipeline.nfa2Dfa nfa+ minDfa = TlexPipeline.minDfa dfa+ in TlexPipeline.dfa2Runner minDfa
+ src/Language/Lexer/Tlex/Data/InputString.hs view
@@ -0,0 +1,48 @@+module Language.Lexer.Tlex.Data.InputString (+ InputStringContext (..),+ InputString (..),+ runInputString,+) where++import Language.Lexer.Tlex.Prelude++import qualified Language.Lexer.Tlex.Runner as Tlex+++data InputStringContext e = InputStringContext+ { inputStringCtxRest :: [e]+ , inputStringCtxPos :: Int+ }+ deriving (Eq, Show)++initialInputStringContext :: [e] -> InputStringContext e+initialInputStringContext s = InputStringContext+ { inputStringCtxRest = s+ , inputStringCtxPos = 0+ }++newtype InputString e a = InputString+ { unInputString :: State (InputStringContext e) a+ }+ deriving (+ Functor,+ Applicative,+ Monad+ ) via State (InputStringContext e)++runInputString :: InputString e a -> [e] -> (a, InputStringContext e)+runInputString (InputString runner) input =+ runState runner do initialInputStringContext input++instance Enum e => Tlex.TlexContext (InputStringContext e) e (InputString e) where+ tlexGetInputPart = InputString do+ inputCtx <- get+ case inputStringCtxRest inputCtx of+ [] -> pure Nothing+ c:r -> do+ put do InputStringContext+ { inputStringCtxRest = r+ , inputStringCtxPos = succ do inputStringCtxPos inputCtx+ }+ pure do Just c+ tlexGetMark = InputString get
+ src/Language/Lexer/Tlex/Pipeline/Dfa2Runner.hs view
@@ -0,0 +1,46 @@+module Language.Lexer.Tlex.Pipeline.Dfa2Runner (+ dfa2Runner,+) where++import Language.Lexer.Tlex.Prelude++import qualified Data.IntMap as IntMap+import qualified Language.Lexer.Tlex.Data.EnumMap as EnumMap+import qualified Language.Lexer.Tlex.Machine.DFA as DFA+import qualified Language.Lexer.Tlex.Machine.Pattern as Pattern+import qualified Language.Lexer.Tlex.Machine.State as MState+import qualified Language.Lexer.Tlex.Runner as Tlex+++dfa2Runner :: Enum e => DFA.DFA a -> Tlex.Runner e a+dfa2Runner dfa = Tlex.Runner+ { tlexInitial = dfaTlexInitial+ , tlexAccept = dfaTlexAccept+ , tlexTrans = dfaTlexTrans+ }+ where+ dfaTlexInitial s0 =+ let ms = EnumMap.lookup+ do toEnum s0+ do DFA.dfaInitials dfa+ in case ms of+ Nothing -> -1+ Just s -> fromEnum s++ dfaTlexAccept s0 =+ let dstState = MState.indexArray+ do DFA.dfaTrans dfa+ do toEnum s0+ in case DFA.dstAccepts dstState of+ [] -> Nothing+ acc:_ -> Just do Pattern.accSemanticAction acc++ dfaTlexTrans s0 c =+ let dstState = MState.indexArray+ do DFA.dfaTrans dfa+ do toEnum s0+ in case IntMap.lookup c do DFA.dstTrans dstState of+ Just s1 -> fromEnum s1+ Nothing -> case DFA.dstOtherTrans dstState of+ Just s1 -> fromEnum s1+ Nothing -> -1
+ src/Language/Lexer/Tlex/Pipeline/Scanner2Nfa.hs view
@@ -0,0 +1,53 @@+module Language.Lexer.Tlex.Pipeline.Scanner2Nfa (+ scanRule2Nfa,+ scanner2Nfa,+) where++import Language.Lexer.Tlex.Prelude++import qualified Language.Lexer.Tlex.Data.EnumMap as EnumMap+import qualified Language.Lexer.Tlex.Machine.NFA as NFA+import qualified Language.Lexer.Tlex.Machine.Pattern as Pattern+import qualified Language.Lexer.Tlex.Machine.State as MState+import qualified Language.Lexer.Tlex.Pipeline.Pattern2Nfa as Pattern2Nfa+import qualified Language.Lexer.Tlex.Syntax as Tlex+++scanRule2Nfa+ :: Enum e+ => Pattern.AcceptPriority -> MState.StateNum -> Tlex.ScanRule e m+ -> NFA.NFABuilder m ()+scanRule2Nfa p b r = do+ e <- NFA.newStateNum+ Pattern2Nfa.pattern2Nfa b e do Tlex.scanRulePattern r++ NFA.accept e+ do Tlex.Accept+ { accPriority = p+ , accSemanticAction = Tlex.scanRuleSemanticAction r+ }++scanner2Nfa :: Enum e => Tlex.Scanner e m -> NFA.NFABuilder m ()+scanner2Nfa Tlex.Scanner{ scannerRules } = foldM_+ do \(p, bs, is) scanRule -> aggScanRule p bs is scanRule+ do (Pattern.mostPriority, [], EnumMap.empty)+ do scannerRules+ where+ aggScanRule p0 bs0 is0 scanRule = do+ b <- NFA.newStateNum+ scanRule2Nfa p0 b scanRule+ is1 <- registerStartState is0 b do Tlex.scanRuleStartStates scanRule+ pure (succ p0, b:bs0, is1)++ registerStartState is0 b ss = foldM+ do \is s -> do+ (is', sn) <- case EnumMap.lookup s is of+ Just x -> pure (is, x)+ Nothing -> do+ x <- NFA.newStateNum+ NFA.initial x s+ pure (EnumMap.insert s x is, x)+ NFA.epsilonTrans sn b+ pure is'+ do is0+ do ss
+ src/Language/Lexer/Tlex/Runner.hs view
@@ -0,0 +1,69 @@+module Language.Lexer.Tlex.Runner (+ TlexContext (..),+ TlexResult (..),+ Runner (..),+ runRunner,+) where++import Language.Lexer.Tlex.Prelude+++class (Enum e, Monad m) => TlexContext p e m | m -> p, m -> e where+ tlexGetInputPart :: m (Maybe e)+ tlexGetMark :: m p++data TlexResult p a+ = TlexEndOfInput+ | TlexError+ | TlexAccepted p a+ deriving (Eq, Show)+++data Runner e a = Runner+ { tlexInitial :: Int -> Int+ -- ^ StartState -> (StateNum | -1)+ , tlexAccept :: Int -> Maybe a+ -- ^ StateNum -> Maybe Action+ , tlexTrans :: Int -> Int -> Int+ -- ^ StateNum -> CodeUnit -> (StateNum | -1)+ }+ deriving Functor++runRunner :: Enum s => TlexContext p c m => Runner c a -> s -> m (TlexResult p a)+runRunner runner s0 = case tlexInitial runner do fromEnum s0 of+ -1 -> error "unknown initial state"+ s -> go s+ where+ go s = case tlexAccept runner s of+ Just x -> do+ acc <- buildAccepted x+ mc <- tlexGetInputPart+ case mc of+ Nothing -> pure acc+ Just c -> goTrans s c do Just acc+ Nothing -> do+ mc <- tlexGetInputPart+ case mc of+ Nothing -> pure TlexEndOfInput+ Just c -> goTrans s c Nothing++ goTrans s c preAccepted = case tlexTrans runner s do fromEnum c of+ -1 -> goEnd preAccepted+ ns -> do+ nacc <- case tlexAccept runner ns of+ Just x -> do+ acc <- buildAccepted x+ pure do Just acc+ Nothing -> pure preAccepted+ mc <- tlexGetInputPart+ case mc of+ Nothing -> goEnd nacc+ Just nc -> goTrans ns nc nacc++ buildAccepted x = do+ m <- tlexGetMark+ pure do TlexAccepted m x++ goEnd preAccepted = case preAccepted of+ Nothing -> pure TlexError+ Just acc -> pure acc
+ src/Language/Lexer/Tlex/Syntax.hs view
@@ -0,0 +1,76 @@+module Language.Lexer.Tlex.Syntax (+ Scanner (..),+ ScanRule (..),+ ScannerBuilder,+ ScannerBuilderContext,+ buildScanner,+ lexRule,+ Pattern.Pattern,+ Pattern.enumsP,+ Pattern.straightEnumSetP,+ anyoneP,+ maybeP,+ someP,+ manyP,+ orP,+ Pattern.StartState,+ Pattern.Accept (..),+ Pattern.AcceptPriority,+) where++import Language.Lexer.Tlex.Prelude++import qualified Language.Lexer.Tlex.Data.SymEnumSet as SymEnumSet+import qualified Language.Lexer.Tlex.Machine.Pattern as Pattern+++newtype Scanner e a = Scanner+ { scannerRules :: [ScanRule e a]+ }+ deriving (Eq, Show, Functor)++data ScanRule e a = ScanRule+ { scanRuleStartStates :: [Pattern.StartState]+ , scanRulePattern :: Pattern.Pattern e+ , scanRuleSemanticAction :: a+ }+ deriving (Eq, Show, Functor)+++buildScanner :: Enum e => ScannerBuilder s e f () -> Scanner e f+buildScanner builder = Scanner+ { scannerRules = unScannerBuilderContext+ do execState builder do ScannerBuilderContext []+ }++newtype ScannerBuilderContext s e f = ScannerBuilderContext+ { unScannerBuilderContext :: [ScanRule e f]+ }+ deriving (Eq, Show, Functor)++type ScannerBuilder s e f = State (ScannerBuilderContext s e f)++lexRule :: Enum s => Enum e+ => [s] -> Pattern.Pattern e -> f -> ScannerBuilder s e f ()+lexRule ss p act = modify' \(ScannerBuilderContext rs0) ->+ ScannerBuilderContext+ do ScanRule [Pattern.startStateFromEnum s | s <- ss] p act:rs0+++anyoneP :: Enum e => Pattern.Pattern e+anyoneP = Pattern.Range SymEnumSet.full++maybeP :: Enum e => Pattern.Pattern e -> Pattern.Pattern e+maybeP x = orP [x, Pattern.Epsilon]++someP :: Enum e => Pattern.Pattern e -> Pattern.Pattern e+someP x = x <> Pattern.Many x++manyP :: Enum e => Pattern.Pattern e -> Pattern.Pattern e+manyP x = Pattern.Many x++{-# INLINE orP #-}+orP :: Enum e => [Pattern.Pattern e] -> Pattern.Pattern e+orP = \case+ [] -> Pattern.Epsilon+ p:ps -> foldr (Pattern.:|:) p ps
+ test/doctest/Doctest.hs view
@@ -0,0 +1,21 @@+module Main where++import Prelude++import qualified Build_doctests as BuildF+import Control.Monad+import qualified System.Environment as IO+import qualified System.IO as IO+import Test.DocTest (doctest)++main :: IO ()+main = forM_ BuildF.components \(BuildF.Component name flags pkgs sources) -> do+ putStrLn "============================================="+ print name+ putStrLn "---------------------------------------------"+ IO.hFlush IO.stdout+ let args = flags ++ pkgs ++ sources+ IO.unsetEnv "GHC_ENVIRONMENT"+ doctest args+ putStrLn "============================================="+ IO.hFlush IO.stdout
+ test/spec/HSpecDriver.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ tlex.cabal view
@@ -0,0 +1,155 @@+cabal-version: 3.0+build-type: Custom++name: tlex+version: 0.1.0.0+license: Apache-2.0 OR MPL-2.0+license-file: LICENSE+copyright: (c) 2020 Mizunashi Mana+author: Mizunashi Mana+maintainer: mizunashi-mana@noreply.git++category: Parsing+homepage: https://github.com/mizunashi-mana/tlex+bug-reports: https://github.com/mizunashi-mana/tlex/issues+synopsis: A lexer generator+description:+ Tlex is haskell libraries and toolchains for generating lexical analyzer.++extra-source-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/mizunashi-mana/tlex.git++flag develop+ default: False+ manual: True+ description: Turn on some options for development++common general+ default-language:+ Haskell2010+ default-extensions:+ NoImplicitPrelude+ BangPatterns+ BinaryLiterals+ BlockArguments+ ConstraintKinds+ DataKinds+ DefaultSignatures+ DeriveFoldable+ DeriveFunctor+ DeriveGeneric+ DeriveLift+ DeriveTraversable+ DerivingVia+ DuplicateRecordFields+ EmptyCase+ FlexibleContexts+ FlexibleInstances+ FunctionalDependencies+ GADTs+ InstanceSigs+ LambdaCase+ MagicHash+ MultiParamTypeClasses+ MultiWayIf+ NamedFieldPuns+ NegativeLiterals+ NumericUnderscores+ OverloadedLabels+ PackageImports+ PatternSynonyms+ PolyKinds+ RankNTypes+ ScopedTypeVariables+ StandaloneDeriving+ Strict+ TypeApplications+ TypeFamilies+ TypeOperators+ UnboxedSums+ UnboxedTuples++ if flag(develop)+ ghc-options:+ -Wall+ -Wcompat+ -Wincomplete-uni-patterns+ -Wmonomorphism-restriction+ -Wpartial-fields++ -fprint-explicit-foralls+ -frefinement-level-hole-fits=1++ -dcore-lint++ build-depends:+ base >= 4.12.0 && < 4.15,++ -- project depends+ tlex-core >= 0.1.0 && < 0.2,+ containers >= 0.6.0 && < 0.7,++ autogen-modules:+ Paths_tlex+ other-modules:+ Paths_tlex++custom-setup+ setup-depends:+ base,+ Cabal,+ cabal-doctest,++library+ import:+ general,+ hs-source-dirs:+ src+ exposed-modules:+ Language.Lexer.Tlex+ Language.Lexer.Tlex.Syntax+ Language.Lexer.Tlex.Runner+ Language.Lexer.Tlex.Pipeline.Scanner2Nfa+ Language.Lexer.Tlex.Pipeline.Dfa2Runner+ Language.Lexer.Tlex.Data.InputString++test-suite doctest+ import:+ general,+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ test/doctest+ main-is:+ Doctest.hs+ build-depends:+ doctest,+ QuickCheck,+ autogen-modules:+ Build_doctests+ other-modules:+ Build_doctests++test-suite spec+ import:+ general,+ type:+ exitcode-stdio-1.0+ hs-source-dirs:+ test/spec+ main-is:+ HSpecDriver.hs+ ghc-options:+ -Wno-missing-home-modules+ build-tool-depends:+ hspec-discover:hspec-discover,+ build-depends:+ tlex,++ hspec,+ QuickCheck,