parsley-core 1.8.0.0 → 2.0.0.0

raw patch · 11 files changed

+77/−159 lines, 11 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +8/−0
• parsley-core.cabal +12/−12
• src/ghc-8.10+/Parsley/Internal/Backend/Machine.hs +1/−1
• src/ghc-8.10+/Parsley/Internal/Backend/Machine/Defunc.hs +2/−11
• src/ghc-8.6+/Parsley/Internal/Backend/Machine.hs +1/−1
• src/ghc-8.6+/Parsley/Internal/Backend/Machine/Defunc.hs +1/−4
• src/ghc/Parsley/Internal.hs +1/−19
• src/ghc/Parsley/Internal/Backend/CodeGenerator.hs +3/−3
• src/ghc/Parsley/Internal/Core.hs +1/−10
• src/ghc/Parsley/Internal/Core/Defunc.hs +46/−41
• src/ghc/Parsley/Internal/Core/Primitives.hs +1/−57

@@ -131,3 +131,11 @@ * Added `PosSelector` * Added `line` and `col` to primitives and `Position` to Combinator AST, as well as `SelectPos` to instructions. * Changed `OFFSET` to `INPUT` in `Defunc`++## 2.0.0.0 -- 2021-11-24++* Removed `compile`, `eval`, `codeGen` from the API.+* Removed `chainPre` and `chainPost` from the API.+* Added `Typeable` constraint to `LIFTED`.+* Removed `lamTermBool` and `userBool` from the API: `Typeable` subsumes them.+* Added `RANGES` to the `Defunc` API.

@@ -5,7 +5,7 @@ --                   | +------- breaking internal API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             1.8.0.0+version:             2.0.0.0 synopsis:            A fast parser combinator library backed by Typed Template Haskell description:         This package contains the internals of the @parsley@ package.                      .@@ -111,17 +111,17 @@                        Parsley.Internal.Backend.Machine.Types.Input.Offset                        --Parsley.Internal.Backend.Machine.Types.Input.Pos -  default-extensions:  BangPatterns,-                       DataKinds,-                       GADTs,-                       FlexibleContexts,-                       FlexibleInstances,-                       KindSignatures,-                       PolyKinds,-                       RankNTypes,-                       ScopedTypeVariables,-                       TemplateHaskell,-                       TypeOperators,+  default-extensions:  BangPatterns+                       DataKinds+                       GADTs+                       FlexibleContexts+                       FlexibleInstances+                       KindSignatures+                       PolyKinds+                       RankNTypes+                       ScopedTypeVariables+                       TemplateHaskell+                       TypeOperators                         NoStarIsType 

@@ -20,7 +20,7 @@ import Data.ByteString                               (ByteString) import Data.Dependent.Map                            (DMap) import Data.Text                                     (Text)-import Parsley.Internal.Backend.Machine.Defunc       (user, userBool)+import Parsley.Internal.Backend.Machine.Defunc       (user) import Parsley.Internal.Backend.Machine.Identifiers import Parsley.Internal.Backend.Machine.InputOps     (InputPrep(..)) import Parsley.Internal.Backend.Machine.Instructions

@@ -13,7 +13,7 @@ -} module Parsley.Internal.Backend.Machine.Defunc (     Defunc(..),-    user, userBool,+    user,     ap, ap2,     _if,     genDefunc,@@ -24,7 +24,7 @@ import Parsley.Internal.Common.Utils                (Code) import Parsley.Internal.Core.Lam                    (Lam, normaliseGen, normalise) -import qualified Parsley.Internal.Core.Defunc as Core (Defunc, lamTerm, lamTermBool)+import qualified Parsley.Internal.Core.Defunc as Core (Defunc, lamTerm) import qualified Parsley.Internal.Core.Lam    as Lam  (Lam(..))  {-|@@ -64,15 +64,6 @@ -} user :: Core.Defunc a -> Defunc a user = LAM . Core.lamTerm--{-|-Promotes a @Defunc@ value from the Frontend API into a Backend one,-for values representing @a -> Bool@.--@since 1.3.0.0--}-userBool :: Core.Defunc (a -> Bool) -> Defunc (a -> Bool)-userBool = LAM . Core.lamTermBool  {-| Applies a function to a value when both are `Defunc`.

@@ -20,7 +20,7 @@ import Data.ByteString                               (ByteString) import Data.Dependent.Map                            (DMap) import Data.Text                                     (Text)-import Parsley.Internal.Backend.Machine.Defunc       (user, userBool)+import Parsley.Internal.Backend.Machine.Defunc       (user) import Parsley.Internal.Backend.Machine.Identifiers import Parsley.Internal.Backend.Machine.InputOps     (InputPrep(..)) import Parsley.Internal.Backend.Machine.InputRep     (Rep)

@@ -5,7 +5,7 @@ import Parsley.Internal.Common.Utils             (Code) import Parsley.Internal.Core.Lam                 (Lam, normaliseGen, normalise) -import qualified Parsley.Internal.Core.Defunc as Core (Defunc, lamTerm, lamTermBool)+import qualified Parsley.Internal.Core.Defunc as Core (Defunc, lamTerm) import qualified Parsley.Internal.Core.Lam    as Lam  (Lam(..))  data Defunc a where@@ -15,9 +15,6 @@  user :: Core.Defunc a -> Defunc a user = LAM . Core.lamTerm--userBool :: Core.Defunc (a -> Bool) -> Defunc (a -> Bool)-userBool = LAM . Core.lamTermBool  ap :: Defunc (a -> b) -> Defunc a -> Defunc b ap f x = LAM (Lam.App (unliftDefunc f) (unliftDefunc x))

@@ -1,4 +1,4 @@-{-# LANGUAGE PatternSynonyms, CPP #-}+{-# LANGUAGE PatternSynonyms #-} {-| Module      : Parsley.Internal Description : The gateway into the internals: here be monsters!@@ -16,35 +16,21 @@     module Primitives,     module THUtils,     module Trace,-#if MIN_VERSION_parsley_core(2,0,0)-#else-    module Frontend,-#endif     module Backend,     parse   ) where -#if MIN_VERSION_parsley_core(2,0,0) import Parsley.Internal.Backend  (codeGen, eval) import Parsley.Internal.Frontend (compile)-#endif  import Parsley.Internal.Backend         as Backend    (     Input,-#if MIN_VERSION_parsley_core(2,0,0)-#else-    codeGen, eval-#endif   ) import Parsley.Internal.Core            as Core import Parsley.Internal.Core.Primitives as Primitives (     pure, (<*>), (*>), (<*),     (<|>), empty,     satisfy, lookAhead, try, notFollowedBy,-#if MIN_VERSION_parsley_core(2,0,0)-#else-    chainPre, chainPost,-#endif     loop,     Reg, newRegister, get, put,     conditional, branch,@@ -52,10 +38,6 @@     debug   ) import Parsley.Internal.Common.Utils    as THUtils    (Quapplicative(..), WQ, Code, makeQ)-#if MIN_VERSION_parsley_core(2,0,0)-#else-import Parsley.Internal.Frontend        as Frontend   (compile)-#endif import Parsley.Internal.Trace           as Trace      (Trace(trace))  parse :: (Trace, Input input) => Parser a -> Code (input -> Maybe a)

@@ -16,7 +16,7 @@  import Data.Set                            (Set, elems) import Control.Monad.Trans                 (lift)-import Parsley.Internal.Backend.Machine    (user, userBool, LetBinding, makeLetBinding, newMeta, Instr(..), Handler(..),+import Parsley.Internal.Backend.Machine    (user, LetBinding, makeLetBinding, newMeta, Instr(..), Handler(..),                                             _Fmap, _App, _Get, _Put, _Make,                                             addCoins, refundCoins, drainCoins, giveBursary, blockCoins,                                             minus, minCoins, maxCoins, zero,@@ -118,7 +118,7 @@  shallow :: Trace => Combinator (CodeGen o a) x -> Fix4 (Instr o) (x : xs) (Succ n) r a -> CodeGenStack (Fix4 (Instr o) xs (Succ n) r a) shallow (Pure x)      m = do return $! In4 (Push (user x) m)-shallow (Satisfy p)   m = do return $! In4 (Sat (userBool p) m)+shallow (Satisfy p)   m = do return $! In4 (Sat (user p) m) shallow (pf :<*>: px) m = do pxc <- runCodeGen px (In4 (_App m)); runCodeGen pf pxc shallow (p :*>: q)    m = do qc <- runCodeGen q m; runCodeGen p (In4 (Pop qc)) shallow (p :<*: q)    m = do qc <- runCodeGen q (In4 (Pop m)); runCodeGen p qc@@ -146,7 +146,7 @@   do (binder, φ) <- makeΦ m      qcs <- traverse (\q -> freshΦ (runCodeGen q φ)) qs      defc <- freshΦ (runCodeGen def φ)-     let minc = coinsNeeded (In4 (Choices (map userBool fs) qcs defc))+     let minc = coinsNeeded (In4 (Choices (map user fs) qcs defc))      let defc':qcs' = map (maxCoins zero . (`minus` minc) . coinsNeeded >>= addCoins) (defc:qcs)      fmap binder (runCodeGen p (In4 (Choices (map user fs) qcs' defc'))) shallow (Let _ μ)                    m = do return $! tailCallOptimise μ m

@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-| Module      : Parsley.Internal.Core Description : The main AST and datatypes are found here@@ -10,18 +9,10 @@ -} module Parsley.Internal.Core (     Parser,-#if MIN_VERSION_parsley_core(2,0,0)-#else-    ParserOps,-#endif     module Parsley.Internal.Core.Defunc,     module Parsley.Internal.Core.InputTypes   ) where -import Parsley.Internal.Core.Defunc hiding (lamTerm, lamTermBool)+import Parsley.Internal.Core.Defunc hiding (lamTerm) import Parsley.Internal.Core.InputTypes-#if MIN_VERSION_parsley_core(2,0,0) import Parsley.Internal.Core.Primitives (Parser)-#else-import Parsley.Internal.Core.Primitives (Parser, ParserOps)-#endif

@@ -14,21 +14,15 @@ module Parsley.Internal.Core.Defunc (     Defunc(..),     pattern COMPOSE_H, pattern FLIP_H, pattern FLIP_CONST, pattern UNIT,-    lamTerm, lamTermBool+    lamTerm   ) where ---import Data.Typeable                 (Typeable, (:~:)(Refl), eqT)+import Data.List                     (intercalate)+import Data.Typeable                 (Typeable, (:~:)(Refl), eqT) import Language.Haskell.TH.Syntax    (Lift(..)) import Parsley.Internal.Common.Utils (WQ(..), Code, Quapplicative(..)) import Parsley.Internal.Core.Lam     (normaliseGen, Lam(..)) -{--  TODO: We should support Typeable in LIFTED to be more general, but I don't want changes to-  Defunc to impact back-compat in parsley itself. We should consider not exposing the datatype-  anymore, but exposing smart-constructors in Parsley.Defunctionalized.-  This will come in parsley-2.0.0.0.--}- {-| This datatype is useful for providing an /inspectable/ representation of common Haskell functions. These can be provided in place of `WQ` to any combinator that requires it. The only difference is@@ -51,8 +45,8 @@   APP_H   :: Defunc (a -> b) -> Defunc a -> Defunc b   -- | Corresponds to the partially applied @(== x)@ for some `Defunc` value @x@.   EQ_H    :: Eq a => Defunc a -> Defunc (a -> Bool)-  -- | Represents a liftable, showable value.-  LIFTED  :: (Show a, Lift a{-, Typeable a-}) => a -> Defunc a+  -- | Represents a liftable, showable, typable value.+  LIFTED  :: (Show a, Lift a, Typeable a) => a -> Defunc a   -- | Represents the standard @(:)@ function applied to no arguments.   CONS    :: Defunc (a -> [a] -> [a])   -- | Represents the standard @const@ function applied to no arguments.@@ -62,6 +56,16 @@   -- | Wraps up any value of type `WQ`.   BLACK   :: WQ a -> Defunc a +  {-|+  Designed to be a specialised form of character predicate: is a character within some given ranges+  (which are inclusive at both ends).++  @since 2.0.0.0+  -}+  RANGES  :: Bool                  -- ^ Does the range test for membership (@True@) or /no/ membership (@False@).+          -> [(Char, Char)]        -- ^ List of ranges of the form @(l, u)@: @l@ and @u@ are inclusive to the range.+          -> Defunc (Char -> Bool)+   -- Syntax constructors   {-|   Represents the regular Haskell @if@ syntax.@@ -88,21 +92,23 @@ @since 0.1.0.0 -} instance Quapplicative Defunc where-  makeQ x qx        = BLACK (makeQ x qx)-  _val ID           = id-  _val COMPOSE      = (.)-  _val FLIP         = flip-  _val (APP_H f x)  = _val f (_val x)-  _val (LIFTED x)   = x-  _val (EQ_H x)     = (_val x ==)-  _val CONS         = (:)-  _val CONST        = const-  _val EMPTY        = []-  _val (BLACK f)    = _val f+  makeQ x qx               = BLACK (makeQ x qx)+  _val ID                  = id+  _val COMPOSE             = (.)+  _val FLIP                = flip+  _val (APP_H f x)         = _val f (_val x)+  _val (LIFTED x)          = x+  _val (EQ_H x)            = (_val x ==)+  _val CONS                = (:)+  _val CONST               = const+  _val EMPTY               = []+  _val (BLACK f)           = _val f   -- Syntax-  _val (IF_S c t e) = if _val c then _val t else _val e-  _val (LAM_S f)    = \x -> _val (f (makeQ x undefined))-  _val (LET_S x f)  = let y = _val x in _val (f (makeQ y undefined))+  _val (IF_S c t e)        = if _val c then _val t else _val e+  _val (LAM_S f)           = \x -> _val (f (makeQ x undefined))+  _val (LET_S x f)         = let y = _val x in _val (f (makeQ y undefined))+  _val (RANGES True rngs)  = \c -> any (\(l, u) -> l <= c || c <= u) rngs+  _val (RANGES False rngs) = \c -> all (\(l, u) -> l >= c || c >= u) rngs   _code = normaliseGen . lamTerm   (>*<) = APP_H @@ -135,38 +141,36 @@ pattern UNIT          :: Defunc () pattern UNIT          = LIFTED () --- TODO: This is deprecated in favour of Typeable as of parsley 2.0.0.0 {-|-Specialised conversion for functions returning `Bool`. This will go-as soon as `Defunc` has a `Typeable` constraint in parsley 2.--@since 1.0.1.0--}-lamTermBool :: Defunc (a -> Bool) -> Lam (a -> Bool)-lamTermBool (APP_H CONST (LIFTED True)) = Abs (const T)-lamTermBool (APP_H CONST (LIFTED False)) = Abs (const F)-lamTermBool f = lamTerm f--{-| Converts a `Defunc` value into an equivalent `Lam` value, discarding the inspectivity of functions.  @since 1.0.1.0 -}-lamTerm :: {-forall a.-} Defunc a -> Lam a+lamTerm :: forall a. Defunc a -> Lam a lamTerm ID = Abs id lamTerm COMPOSE = Abs (\f -> Abs (\g -> Abs (App f . App g))) lamTerm FLIP = Abs (\f -> Abs (\x -> Abs (\y -> App (App f y) x))) lamTerm (APP_H f x) = App (lamTerm f) (lamTerm x)-{-lamTerm (LIFTED b) | Just Refl <- eqT @a @Bool = case b of-  False -> F-  True -> T-}+lamTerm (LIFTED b) | Just Refl <- eqT @a @Bool = if b then T else F lamTerm (LIFTED x) = Var True [||x||] lamTerm (EQ_H x) = Abs (App (App (Var True [||(==)||]) (lamTerm x))) lamTerm CONS = Var True [||(:)||] lamTerm EMPTY = Var True [||[]||] lamTerm CONST = Abs (Abs . const) lamTerm (BLACK x) = Var False (_code x)+lamTerm (RANGES incl []) = Abs (const (if incl then F else T))+lamTerm (RANGES incl [(l, u)]) | l == minBound, u == maxBound = Abs (const (if incl then T else F))+lamTerm (RANGES incl rngs) =+  Abs $ \c ->+    App (if incl then Abs id else Var True [||not||])+        (foldr1 (App . App (Var True [||(||)||]))+          (map (\(l, u) ->+            if l == u then App (App (Var True [||(==)||]) c) (Var True [||l||])+                      else App (App (Var True [||(&&)||])+                               (App (App (Var True [||(<=)||]) (Var True [||l||])) c))+                               (App (App (Var True [||(<=)||]) c) (Var True [||u||])))+           rngs)) lamTerm (LAM_S f) = Abs (adaptLam f) lamTerm (IF_S c t e) = If (lamTerm c) (lamTerm t) (lamTerm e) lamTerm (LET_S x f) = Let (lamTerm x) (adaptLam f)@@ -200,4 +204,5 @@   show CONST = "const"   show (IF_S c b e) = concat ["(if ", show c, " then ", show b, " else ", show e, ")"]   show (LAM_S _) = "f"+  show (RANGES incl rngs) = concat [if incl then "not " else "", "elem (", intercalate " ++ " (map (\(l, u) -> concat ["[", show l, "..", show u, "]"]) rngs), ")"]   show _ = "x"

@@ -1,4 +1,4 @@-{-# LANGUAGE PatternSynonyms, CPP #-}+{-# LANGUAGE PatternSynonyms #-} module Parsley.Internal.Core.Primitives (     Parser,     Reg,@@ -6,18 +6,11 @@   ) where  import Prelude hiding                      (pure, (<*>))-import Control.Arrow                       (first) import Parsley.Internal.Core.CombinatorAST (Combinator(..), ScopeRegister(..), Reg(..), Parser(..), PosSelector(..))-#if MIN_VERSION_parsley_core(2,0,0) import Parsley.Internal.Core.Defunc        (Defunc)-#else-import Parsley.Internal.Core.Defunc        (Defunc(BLACK, ID, COMPOSE), pattern FLIP_H)-import Parsley.Internal.Common.Utils       (WQ)-#endif  import Parsley.Internal.Common.Indexed     (Fix(In), (:+:)(..)) -#if MIN_VERSION_parsley_core(2,0,0) -- Core smart constructors {-# INLINE pure #-} pure :: Defunc a -> Parser a@@ -32,38 +25,7 @@ conditional cs (Parser p) (Parser def) =   let (fs, qs) = unzip cs   in Parser (In (L (Match p fs (map unParser qs) def)))-#else-class ParserOps rep where-  pure :: rep a -> Parser a-  satisfy :: rep (Char -> Bool) -> Parser Char-  conditional :: [(rep (a -> Bool), Parser b)] -> Parser a -> Parser b -> Parser b -instance ParserOps WQ where-  pure = pure . BLACK-  satisfy = satisfy . BLACK-  conditional = conditional . map (first BLACK)--instance {-# INCOHERENT #-} x ~ Defunc => ParserOps x where-  pure = _pure-  satisfy = _satisfy-  conditional = _conditional---- Core smart constructors-{-# INLINE _pure #-}-_pure :: Defunc a -> Parser a-_pure = Parser . In . L . Pure--{-# INLINE _satisfy #-}-_satisfy :: Defunc (Char -> Bool) -> Parser Char-_satisfy = Parser . In . L . Satisfy--{-# INLINE _conditional #-}-_conditional :: [(Defunc (a -> Bool), Parser b)] -> Parser a -> Parser b -> Parser b-_conditional cs (Parser p) (Parser def) =-  let (fs, qs) = unzip cs-  in Parser (In (L (Match p fs (map unParser qs) def)))-#endif- {-# INLINE (<*>) #-} (<*>) :: Parser (a -> b) -> Parser a -> Parser b Parser p <*> Parser q = Parser (In (L (p :<*>: q)))@@ -99,24 +61,6 @@ {-# INLINE branch #-} branch :: Parser (Either a b) -> Parser (a -> c) -> Parser (b -> c) -> Parser c branch (Parser c) (Parser p) (Parser q) = Parser (In (L (Branch c p q)))--#if MIN_VERSION_parsley_core(2,0,0)-#else-{-# INLINE chainPre #-}-chainPre :: Parser (a -> a) -> Parser a -> Parser a-chainPre op p =-  newRegister (pure ID) (\r ->-    loop (put r (pure (FLIP_H COMPOSE) <*> op <*> get r))-         (get r))-  <*> p--{-# INLINE chainPost #-}-chainPost :: Parser a -> Parser (a -> a) -> Parser a-chainPost p op =-  newRegister p $ \r ->-    loop (put r (op <*> get r))-         (get r)-#endif  {-# INLINE loop #-} loop :: Parser () -> Parser a -> Parser a