tlex-debug (empty) → 0.1.0.0
raw patch · 9 files changed
+378/−0 lines, 9 filesdep +QuickCheckdep +basedep +containersbuild-type:Customsetup-changed
Dependencies added: QuickCheck, base, containers, doctest, hspec, tlex, tlex-core, tlex-debug, unordered-containers
Files
- CHANGELOG.md +3/−0
- LICENSE +5/−0
- README.md +1/−0
- Setup.hs +6/−0
- src/Language/Lexer/Tlex/Plugin/Debug.hs +107/−0
- src/Language/Lexer/Tlex/Plugin/Debug/Graphviz.hs +80/−0
- test/doctest/Doctest.hs +21/−0
- test/spec/HSpecDriver.hs +1/−0
- tlex-debug.cabal +154/−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,1 @@+See https://hackage.haskell.org/package/tlex
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main where++import Distribution.Extra.Doctest (defaultMainWithDoctests)++main :: IO ()+main = defaultMainWithDoctests "doctest"
+ src/Language/Lexer/Tlex/Plugin/Debug.hs view
@@ -0,0 +1,107 @@+module Language.Lexer.Tlex.Plugin.Debug (+ outputDfaToDot,+ Graphviz.outputAst,+) where++import Language.Lexer.Tlex.Prelude++import qualified Data.HashMap.Strict as HashMap+import qualified Data.IntMap.Strict as IntMap+import qualified Data.IntSet as IntSet+import qualified Language.Lexer.Tlex.Data.EnumMap as EnumMap+import qualified Language.Lexer.Tlex.Machine.DFA as DFA+import qualified Language.Lexer.Tlex.Machine.State as MState+import qualified Language.Lexer.Tlex.Plugin.Debug.Graphviz as Graphviz+import qualified Prelude+++newtype EdgeBuilder = EdgeBuilder+ { unEdgeBuilder :: HashMap.HashMap+ (MState.StateNum, MState.StateNum)+ IntSet.IntSet+ }++instance Semigroup EdgeBuilder where+ EdgeBuilder m1 <> EdgeBuilder m2 = EdgeBuilder do HashMap.unionWith (<>) m1 m2++instance Monoid EdgeBuilder where+ mempty = EdgeBuilder HashMap.empty++edgeBuilder :: MState.StateNum -> Int -> MState.StateNum -> EdgeBuilder+edgeBuilder sf lb st = EdgeBuilder do HashMap.singleton (sf, st) do IntSet.singleton lb++outputDfaToDot :: DFA.DFA a -> Graphviz.Ast+outputDfaToDot dfa = Graphviz.Ast+ { Graphviz.nodes = initialNode :+ [ node sn dst+ | (sn, dst) <- MState.arrayAssocs do DFA.dfaTrans dfa+ ]+ , Graphviz.edges = initialEdges +++ concatMap+ do \(sn, dst) -> edges sn dst+ do MState.arrayAssocs do DFA.dfaTrans dfa+ }+ where+ initialNode = Graphviz.Node+ { Graphviz.nodeId = "init"+ , Graphviz.nodeLabel = Nothing+ , Graphviz.nodeShape = Nothing+ }++ node sn dst = Graphviz.Node+ { Graphviz.nodeId = show do fromEnum sn+ , Graphviz.nodeLabel = Nothing+ , Graphviz.nodeShape = case DFA.dstAccepts dst of+ [] -> Nothing+ _ -> Just Graphviz.DoubleCircle+ }++ initialEdges =+ [ Graphviz.Edge+ { Graphviz.edgeFrom = "init"+ , Graphviz.edgeTo = show do fromEnum sn+ , Graphviz.edgeLabel = Nothing+ }+ | (_, sn) <- EnumMap.assocs do DFA.dfaInitials dfa+ ]++ edges sn dst =+ let builder =+ do case DFA.dstOtherTrans dst of+ Nothing -> mempty+ Just ot -> edgeBuilder sn -1 ot+ <> foldMap+ do \(lb, to) -> edgeBuilder sn lb to+ do IntMap.assocs do DFA.dstTrans dst+ in+ [ edge fr lb to+ | ((fr, to), lb) <- HashMap.toList do unEdgeBuilder builder+ ]++ edge :: MState.StateNum -> IntSet.IntSet -> MState.StateNum -> Graphviz.Edge+ edge fr lb to = Graphviz.Edge+ { Graphviz.edgeFrom = show do fromEnum fr+ , Graphviz.edgeTo = show do fromEnum to+ , Graphviz.edgeLabel = edgeLabel lb+ }++edgeLabel :: IntSet.IntSet -> Maybe Prelude.String+edgeLabel xs0 = case IntSet.toAscList xs0 of+ [] -> Nothing+ x0:xs ->+ let endPrevRange (s, p, b) = case b of+ True -> s+ False -> s . ("-" ++) . (show p ++)+ s0 = endPrevRange+ do foldl'+ do \ctx@(!s, !p, _) x -> if+ | x == p + 1 -> (s, x, False)+ | otherwise ->+ ( endPrevRange ctx . ("," ++) . (show x ++)+ , x+ , True+ )+ do ((show x0 ++), x0, True)+ do xs+ in Just do "[" ++ s0 "]"+
+ src/Language/Lexer/Tlex/Plugin/Debug/Graphviz.hs view
@@ -0,0 +1,80 @@+module Language.Lexer.Tlex.Plugin.Debug.Graphviz (+ NodeShape (..),+ Node (..),+ Edge (..),+ Ast (..),+ outputAst,+) where++import Language.Lexer.Tlex.Prelude++import qualified Prelude+++data NodeShape+ = DoubleCircle+ | Circle+ deriving (Eq, Show, Ord, Enum)++type NodeId = Prelude.String++data Node = Node+ { nodeId :: NodeId+ , nodeLabel :: Maybe Prelude.String+ , nodeShape :: Maybe NodeShape+ }+ deriving (Eq, Show)++data Edge = Edge+ { edgeFrom :: NodeId+ , edgeTo :: NodeId+ , edgeLabel :: Maybe Prelude.String+ }+ deriving (Eq, Show)++data Ast = Ast+ { nodes :: [Node]+ , edges :: [Edge]+ }+ deriving (Eq, Show)++outputAst :: Ast -> Prelude.String+outputAst ast =+ "digraph {\n" +++ nodeDef +++ edgeDef +++ "}"+ where+ nodeDef = concatMap+ do \n ->+ nodeId n +++ " [" +++ do case nodeLabel n of+ Just lb -> "label = \"" ++ lb ++ "\","+ Nothing -> ""+ +++ do case nodeShape n of+ Nothing -> ""+ Just sh ->+ "shape = " +++ do case sh of+ DoubleCircle -> "doublecircle"+ Circle -> "circle"+ +++ ","+ +++ "];\n"+ do nodes ast++ edgeDef = concatMap+ do \e ->+ edgeFrom e +++ " -> " +++ edgeTo e +++ " [" +++ do case edgeLabel e of+ Just lb -> "label = \"" ++ lb ++ "\","+ Nothing -> ""+ +++ "];\n"+ do edges ast
+ 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-debug.cabal view
@@ -0,0 +1,154 @@+cabal-version: 3.0+build-type: Custom++name: tlex-debug+version: 0.1.0.0+license: Apache-2.0 OR MPL-2.0+license-file: LICENSE+copyright: (c) 2021 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: Debug utilities for Tlex+description:+ Tlex is haskell libraries and toolchains for generating lexical analyzer.+ See also: https://github.com/mizunashi-mana/tlex++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,+ tlex >= 0.1.0 && < 0.2,+ containers >= 0.6.0 && < 0.7,+ unordered-containers >= 0.2.13 && < 0.3,++ autogen-modules:+ Paths_tlex_debug+ other-modules:+ Paths_tlex_debug++custom-setup+ setup-depends:+ base,+ Cabal,+ cabal-doctest,++library+ import:+ general,+ hs-source-dirs:+ src+ exposed-modules:+ Language.Lexer.Tlex.Plugin.Debug+ Language.Lexer.Tlex.Plugin.Debug.Graphviz++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-debug,++ hspec,+ QuickCheck,