tlex-encoding (empty) → 0.1.0.0
raw patch · 12 files changed
+575/−0 lines, 12 filesdep +QuickCheckdep +basedep +charsetbuild-type:Customsetup-changed
Dependencies added: QuickCheck, base, charset, containers, doctest, hspec, tlex, tlex-core, tlex-encoding
Files
- CHANGELOG.md +3/−0
- LICENSE +5/−0
- README.md +1/−0
- Setup.hs +6/−0
- src/Language/Lexer/Tlex/Data/NonEmptyEnumStringSet.hs +81/−0
- src/Language/Lexer/Tlex/Data/Reporter.hs +56/−0
- src/Language/Lexer/Tlex/Plugin/Encoding.hs +7/−0
- src/Language/Lexer/Tlex/Plugin/Encoding/CharSetP.hs +64/−0
- src/Language/Lexer/Tlex/Plugin/Encoding/UTF8.hs +171/−0
- test/doctest/Doctest.hs +21/−0
- test/spec/HSpecDriver.hs +1/−0
- tlex-encoding.cabal +159/−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/Data/NonEmptyEnumStringSet.hs view
@@ -0,0 +1,81 @@+module Language.Lexer.Tlex.Data.NonEmptyEnumStringSet (+ NonEmptyEnumStringSet (..),+ empty,+ insert,+ insertSingleByte,+ singleton,+ union,+ intersection,+ fromList,+) where++import Prelude++import qualified Data.List.NonEmpty as NonEmpty+import qualified Language.Lexer.Tlex.Data.EnumMap as EnumMap+import qualified Language.Lexer.Tlex.Data.EnumSet as EnumSet+++data NonEmptyEnumStringSet a = NonEmptyEnumStringSet+ { singleEnums :: EnumSet.EnumSet a+ , enumStrings :: EnumMap.EnumMap a (NonEmptyEnumStringSet a)+ }+ deriving (Eq, Show)++empty :: Enum a => NonEmptyEnumStringSet a+empty = NonEmptyEnumStringSet+ { singleEnums = EnumSet.empty+ , enumStrings = EnumMap.empty+ }++singleton :: Enum a => NonEmpty.NonEmpty a -> NonEmptyEnumStringSet a+singleton (x NonEmpty.:| xs) = case xs of+ [] -> NonEmptyEnumStringSet+ { singleEnums = EnumSet.singleton x+ , enumStrings = EnumMap.empty+ }+ y:ys -> NonEmptyEnumStringSet+ { singleEnums = EnumSet.empty+ , enumStrings = EnumMap.singleton x do+ singleton do y NonEmpty.:| ys+ }++insert :: Enum a+ => NonEmpty.NonEmpty a -> NonEmptyEnumStringSet a -> NonEmptyEnumStringSet a+insert (x NonEmpty.:| xs) s = case xs of+ [] -> insertSingleByte x s+ y:ys -> let xs' = y NonEmpty.:| ys in s+ { enumStrings = EnumMap.insertOrUpdate x+ do singleton xs'+ do \xss -> insert xs' xss+ do enumStrings s+ }++insertSingleByte :: Enum a => a -> NonEmptyEnumStringSet a -> NonEmptyEnumStringSet a+insertSingleByte x s = s+ { singleEnums = EnumSet.insert x+ do singleEnums s+ }++union :: Enum a+ => NonEmptyEnumStringSet a -> NonEmptyEnumStringSet a -> NonEmptyEnumStringSet a+union s1 s2 = NonEmptyEnumStringSet+ { singleEnums = singleEnums s1 `EnumSet.union` singleEnums s2+ , enumStrings = EnumMap.unionWith+ do \xs1 xs2 -> xs1 `union` xs2+ do enumStrings s1+ do enumStrings s2+ }++intersection :: Enum a+ => NonEmptyEnumStringSet a -> NonEmptyEnumStringSet a -> NonEmptyEnumStringSet a+intersection s1 s2 = NonEmptyEnumStringSet+ { singleEnums = singleEnums s1 `EnumSet.intersection` singleEnums s2+ , enumStrings = EnumMap.intersectionWith+ do \xs1 xs2 -> xs1 `union` xs2+ do enumStrings s1+ do enumStrings s2+ }++fromList :: Enum a => [NonEmpty.NonEmpty a] -> NonEmptyEnumStringSet a+fromList xs = foldr insert empty xs
+ src/Language/Lexer/Tlex/Data/Reporter.hs view
@@ -0,0 +1,56 @@+module Language.Lexer.Tlex.Data.Reporter (+ Reporter,+ report,+ getResult,+ getReports,+ toEither,+) where++import Language.Lexer.Tlex.Prelude++import qualified Language.Lexer.Tlex.Data.Bag as Bag+++data Reporter e a = Reporter+ { getReportBag :: Bag.Bag e+ , getResult :: a+ }+ deriving (Eq, Show, Functor)++getReports :: Reporter e a -> [e]+getReports x = toList do getReportBag x++report :: e -> Reporter e ()+report x = Reporter+ { getReportBag = Bag.singleton x+ , getResult = ()+ }++toEither :: Reporter e a -> Either [e] a+toEither x = case getReports x of+ [] -> Right do getResult x+ es -> Left es++instance Applicative (Reporter e) where+ pure x = Reporter+ { getReportBag = mempty+ , getResult = x+ }++ mf <*> mx = Reporter+ { getReportBag = getReportBag mf <> getReportBag mx+ , getResult = getResult mf do getResult mx+ }++instance Monad (Reporter e) where+ mx >>= f =+ let my = f do getResult mx+ in Reporter+ { getReportBag = getReportBag mx <> getReportBag my+ , getResult = getResult my+ }++ mx >> my = Reporter+ { getReportBag = getReportBag mx <> getReportBag my+ , getResult = getResult my+ }
+ src/Language/Lexer/Tlex/Plugin/Encoding.hs view
@@ -0,0 +1,7 @@+module Language.Lexer.Tlex.Plugin.Encoding (+ module Language.Lexer.Tlex.Plugin.Encoding.CharSetP,+ module Language.Lexer.Tlex.Plugin.Encoding.UTF8,+) where++import Language.Lexer.Tlex.Plugin.Encoding.CharSetP+import Language.Lexer.Tlex.Plugin.Encoding.UTF8
+ src/Language/Lexer/Tlex/Plugin/Encoding/CharSetP.hs view
@@ -0,0 +1,64 @@+module Language.Lexer.Tlex.Plugin.Encoding.CharSetP (+ Pattern,+ CharSetStdP,+ CharSetP (..),+ charSetP,+ charSetPWithWarnings,+ chP,+ charsP,+ stringP,++ EncodeWarning (..),+ CharSetEncoder (..),+) where++import Language.Lexer.Tlex.Prelude++import qualified Data.CharSet as CharSet+import qualified Data.String as String+import qualified Language.Lexer.Tlex.Data.Reporter as Reporter+import qualified Language.Lexer.Tlex.Syntax as Tlex+++type Pattern = Tlex.Pattern Word8++type CharSetStdP = CharSetP Identity++newtype CharSetP m = CharSetP+ { charSetEncodingP :: CharSet.CharSet -> m Pattern+ }++data EncodeWarning+ = NotSupportedChar Char+ | CustomWarning String.String+ deriving (Eq, Show)++charSetP :: CharSetStdP -> CharSet.CharSet -> Pattern+charSetP p cs = runIdentity do charSetEncodingP p cs++charSetPWithWarnings :: CharSetEncoder m => CharSetP m -> CharSet.CharSet -> m Pattern+charSetPWithWarnings p cs = charSetEncodingP p cs++chP :: CharSetStdP -> Char -> Pattern+chP p c = charSetP p do CharSet.singleton c++charsP :: CharSetStdP -> [Char] -> Pattern+charsP p cs = charSetP p do CharSet.fromList cs++stringP :: CharSetStdP -> String.String -> Pattern+stringP p s = foldMap+ do chP p+ do s+++class Monad m => CharSetEncoder m where+ reportEncodeWarning :: EncodeWarning -> m ()++instance CharSetEncoder Identity where+ reportEncodeWarning _ = pure ()++instance CharSetEncoder (Either EncodeWarning) where+ reportEncodeWarning e = Left e++instance CharSetEncoder (Reporter.Reporter EncodeWarning) where+ reportEncodeWarning e = Reporter.report e
+ src/Language/Lexer/Tlex/Plugin/Encoding/UTF8.hs view
@@ -0,0 +1,171 @@+module Language.Lexer.Tlex.Plugin.Encoding.UTF8 (+ charSetPUtf8,+) where++import Language.Lexer.Tlex.Prelude++import qualified Data.CharSet as CharSet+import qualified Data.IntSet as IntSet+import qualified Language.Lexer.Tlex.Data.EnumMap as EnumMap+import qualified Language.Lexer.Tlex.Data.EnumSet as EnumSet+import qualified Language.Lexer.Tlex.Data.NonEmptyEnumStringSet as NonEmptyEnumStringSet+import qualified Language.Lexer.Tlex.Plugin.Encoding.CharSetP as CharSetP+import qualified Language.Lexer.Tlex.Syntax as Tlex+++charSetPUtf8 :: CharSetP.CharSetEncoder m => CharSetP.CharSetP m+charSetPUtf8 = CharSetP.CharSetP+ { CharSetP.charSetEncodingP = \case+ CharSet.CharSet True _ is -> goStraight is+ CharSet.CharSet False _ is -> goComplement is+ }+ where+ goStraight is = do+ bsSet <- charSetToByteStringSetUtf8 is+ pure do straightP bsSet++ straightP s =+ let singleByteP = Tlex.straightEnumSetP do+ NonEmptyEnumStringSet.singleEnums s+ in Tlex.orP do+ singleByteP:+ [ Tlex.enumsP [c] <> straightP s'+ | (c, s') <- EnumMap.assocs do+ NonEmptyEnumStringSet.enumStrings s+ ]++ goComplement is = do+ bsSet <- charSetToByteStringSetUtf8 is+ pure do complementPFromEnumStrings bsSet++charSetToByteStringSetUtf8 :: CharSetP.CharSetEncoder m+ => IntSet.IntSet -> m (NonEmptyEnumStringSet.NonEmptyEnumStringSet Word8)+charSetToByteStringSetUtf8 is = foldM+ do \s c -> foldStep s c+ do NonEmptyEnumStringSet.empty+ do IntSet.toAscList is+ where+ foldStep s c = if+ | c <= 0x7F -> pure do+ NonEmptyEnumStringSet.insertSingleByte+ do fromIntegral c+ do s+ | c <= 0x7FF ->+ let (c', l) = stringTails c 1+ in pure do+ NonEmptyEnumStringSet.insert+ do (0xC0 + c') :| l+ do s+ | 0xD800 <= c && c <= 0xDFFF -> do+ CharSetP.reportEncodeWarning+ do CharSetP.NotSupportedChar do toEnum c+ pure s+ | c <= 0xFFFF ->+ let (c', l) = stringTails c 2+ in pure do+ NonEmptyEnumStringSet.insert+ do (0xE0 + c') :| l+ do s+ | otherwise ->+ let (c', l) = stringTails c 3+ in pure do+ NonEmptyEnumStringSet.insert+ do (0xF0 + c') :| l+ do s++ stringTails :: Int -> Int -> (Word8, [Word8])+ stringTails c n = stringTails' c [] n+ stringTails' c l = \case+ 0 -> (fromIntegral c, l)+ n ->+ let (c', x) = quotRem c 0x40+ x' = fromIntegral do 0x80 + x+ in stringTails' c'+ do x' : l+ do n - 1++complementPFromEnumStrings+ :: NonEmptyEnumStringSet.NonEmptyEnumStringSet Word8 -> Tlex.Pattern Word8+complementPFromEnumStrings ess0 = Tlex.orP+ [ go [pr1es] []+ , go [pr2es, seqes] [seqesP]+ , go [pr3p1o1es, pr3p1o2es, seqes]+ [ Tlex.straightEnumSetP pr3p1o1es+ , Tlex.straightEnumSetP pr3p1o2es+ , seqesP+ ]+ , go [pr3p2es, seqes, seqes]+ [ Tlex.straightEnumSetP pr3p2es+ , seqesP+ , seqesP+ ]+ , go [pr3p3o1es, pr3p3o2es, seqes]+ [ Tlex.straightEnumSetP pr3p3o1es+ , Tlex.straightEnumSetP pr3p3o2es+ , seqesP+ ]+ , go [pr3p4es, seqes, seqes]+ [ Tlex.straightEnumSetP pr3p4es+ , seqesP+ , seqesP+ ]+ , go [pr4p1o1es, pr4p1o2es, seqes, seqes]+ [ Tlex.straightEnumSetP pr4p1o1es+ , Tlex.straightEnumSetP pr4p1o2es+ , seqesP+ , seqesP+ ]+ , go [pr4p2es, seqes, seqes, seqes]+ [ Tlex.straightEnumSetP pr4p1o1es+ , seqesP+ , seqesP+ , seqesP+ ]+ , go [pr4p3o1es, pr4p3o2es, seqes, seqes]+ [ Tlex.straightEnumSetP pr4p3o1es+ , Tlex.straightEnumSetP pr4p3o2es+ , seqesP+ , seqesP+ ]+ ]+ where+ seqes = EnumSet.fromList @Word8 [0x80..0xBF]+ seqesP = Tlex.straightEnumSetP seqes++ pr1es = EnumSet.fromList @Word8 [0x00..0x7F]+ pr2es = EnumSet.fromList @Word8 [0xC2..0xDF]+ pr3p1o1es = EnumSet.fromList @Word8 [0xE0]+ pr3p1o2es = EnumSet.fromList @Word8 [0xA0..0xBF]+ pr3p2es = EnumSet.fromList @Word8 [0xE1..0xEC]+ pr3p3o1es = EnumSet.fromList @Word8 [0xED]+ pr3p3o2es = EnumSet.fromList @Word8 [0x80..0x9F]+ pr3p4es = EnumSet.fromList @Word8 [0xEE..0xEF]+ pr4p1o1es = EnumSet.fromList @Word8 [0xF0]+ pr4p1o2es = EnumSet.fromList @Word8 [0x90..0xBF]+ pr4p2es = EnumSet.fromList @Word8 [0xF1..0xF3]+ pr4p3o1es = EnumSet.fromList @Word8 [0xF4]+ pr4p3o2es = EnumSet.fromList @Word8 [0x80..0x8F]++ go bess restPs = go' bess restPs ess0++ go' bess restPs ess = case bess of+ [] -> mempty+ [bes] -> Tlex.straightEnumSetP+ do bes `EnumSet.difference` NonEmptyEnumStringSet.singleEnums ess+ bes:bess2 ->+ let mess = NonEmptyEnumStringSet.enumStrings ess+ (nes, ces) = EnumSet.partition+ do \be -> EnumMap.member be mess+ bes+ cesP = Tlex.straightEnumSetP ces <> mconcat restPs+ in Tlex.orP do+ cesP:+ [ go' bess2 nrestPs ness+ | ne <- EnumSet.toList nes+ , let ness = case EnumMap.lookup ne mess of+ Just x -> x+ Nothing -> error "unreachable"+ , let nrestPs = case restPs of+ [] -> []+ _:xs -> xs+ ]
+ 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-encoding.cabal view
@@ -0,0 +1,159 @@+cabal-version: 3.0+build-type: Custom++name: tlex-encoding+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: Encoding plugin 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,+ charset >= 0.3.7 && < 0.4,+ containers >= 0.6.0 && < 0.7,++ autogen-modules:+ Paths_tlex_encoding+ other-modules:+ Paths_tlex_encoding++custom-setup+ setup-depends:+ base,+ Cabal,+ cabal-doctest,++library+ import:+ general,+ hs-source-dirs:+ src+ exposed-modules:+ Language.Lexer.Tlex.Plugin.Encoding+ Language.Lexer.Tlex.Plugin.Encoding.CharSetP+ Language.Lexer.Tlex.Plugin.Encoding.UTF8+ Language.Lexer.Tlex.Data.Reporter++ other-modules:+ Language.Lexer.Tlex.Data.NonEmptyEnumStringSet++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-encoding,++ hspec,+ QuickCheck,