diff --git a/src/Text/ParserCombinators/UU/BasicInstances.hs b/src/Text/ParserCombinators/UU/BasicInstances.hs --- a/src/Text/ParserCombinators/UU/BasicInstances.hs +++ b/src/Text/ParserCombinators/UU/BasicInstances.hs @@ -177,7 +177,7 @@ -- | `pMunchL` recognises the longest prefix of the input for which the passed predicate holds. The message parameer is used when tracing has been switched on. pMunchL :: forall loc state a .((Show a, loc `IsLocationUpdatedBy` a, LL.ListLike state a) => (a -> Bool) -> String -> P (Str a state loc) [a]) -pMunchL p msg = pSymExt splitState (Succ (Zero Infinite)) Nothing +pMunchL p msg = pSymExt splitState (Zero Infinite) Nothing where splitState :: forall r. (([a] -> (Str a state loc) -> Steps r) -> (Str a state loc) -> Steps r) splitState k inp@(Str tts msgs pos del_ok) = show_attempt ("Try Munch: " ++ msg ++ "\n") ( @@ -235,7 +235,7 @@ {-# INLINE show_symbol #-} show_symbol :: String -> b -> b -show_symbol m v = {- trace m -} v +show_symbol m v = {- trace m -} v {-# INLINE show_attempt #-} show_attempt m v = {- trace m -} v diff --git a/src/Text/ParserCombinators/UU/CHANGELOG.hs b/src/Text/ParserCombinators/UU/CHANGELOG.hs --- a/src/Text/ParserCombinators/UU/CHANGELOG.hs +++ b/src/Text/ParserCombinators/UU/CHANGELOG.hs @@ -1,5 +1,9 @@ -- | This module just contains the CHANGELOG -- +-- Version 2.7.1 +-- +-- fixed a subtle black hole which prevented computation of lengths!! You should upgrade. +-- -- Version 2.7.0.2 -- -- * Some types were reformulated to compile correctly with ghc 6.12.3 diff --git a/src/Text/ParserCombinators/UU/Core.hs b/src/Text/ParserCombinators/UU/Core.hs --- a/src/Text/ParserCombinators/UU/Core.hs +++ b/src/Text/ParserCombinators/UU/Core.hs @@ -197,10 +197,10 @@ -- | `mkParser` combines the non-empty descriptor part and the empty descriptor part into a descriptor tupled with the parser triple mkParser :: Maybe (T st a) -> Maybe a -> Nat -> P st a -mkParser np@Nothing ne@Nothing l = P empty np l ne -mkParser np@(Just nt) ne@Nothing l = P nt np l ne -mkParser np@Nothing ne@(Just a) l = P (pure a) np l ne -mkParser np@(Just nt) ne@(Just a) l = P (nt <|> pure a) np l ne +mkParser np ne l = P (mkParser' np ne) np l ne + where mkParser' np@(Just nt) ne@Nothing = nt + mkParser' np@Nothing ne@(Just a) = pure a + mkParser' np@(Just nt) ne@(Just a) = nt <|> pure a -- ! `combine` creates the non-empty parser combine :: (Alternative f) => Maybe t1 -> Maybe t2 -> t -> Maybe t3 @@ -310,11 +310,9 @@ -- for its use see `"Text.ParserCombinators.UU.Demos.Examples"` micro :: P state a -> Int -> P state a P _ np pl pe `micro` i - = let nnp = case np of - Nothing -> Nothing - Just ((T ph pf pr)) -> Just(T ( \ k st -> ph (\ a st -> Micro i (k a st)) st) - ( \ k st -> pf (Micro i .k) st) - ( \ k st -> pr (Micro i .k) st)) + = let nnp = fmap (\ (T ph pf pr) -> (T ( \ k st -> ph (\ a st -> Micro i (k a st)) st) + ( \ k st -> pf (Micro i .k) st) + ( \ k st -> pr (Micro i .k) st))) np in mkParser nnp pe pl -- | For the precise functioning of the `amb` combinators see the paper cited in the "Text.ParserCombinators.UU.README"; @@ -579,12 +577,12 @@ getLength l = l -- | `nat_min` compares two minmal length and returns the shorter length. The second component indicates whether the left --- operand is the smaller one; we cannot use @Either@ since the fisrt component may already be inspected +-- operand is the smaller one; we cannot use @Either@ since the first component may already be inspected -- before we know which operand is finally chosen nat_min :: Nat -> Nat -> Int -> ( Nat -- the actual minimum length , Bool -- whether aternatives should be swapped ) -nat_min (Zero l) (Zero r) n = (Zero (fst(nat_min l r (n+1))), False) +nat_min (Zero l) (Zero r) n = trace' "Both Zero in nat_min\n" (Zero (trace' "Should not be called unless merging?" (fst(nat_min l r (n+1)))), False) nat_min l rr@(Zero r) n = trace' "Right Zero in nat_min\n" (let (m,_) = nat_min l r (n+1) in (Zero m, True)) nat_min ll@(Zero l) r n = trace' "Left Zero in nat_min\n" (let (m,_) = nat_min l r (n+1) @@ -594,11 +592,11 @@ (let (v, b) = nat_min ll rr (n+1) in (Succ v, b)) nat_min Infinite r _ = trace' "Left Infinite in nat_min\n" (r, True) nat_min l Infinite _ = trace' "Right Infinite in nat_min\n" (l, False) -nat_min Unspecified r _ = (r, False) -- leave the alternatives in the order they are -nat_min l Unspecified _ = (l, False) -- leave the alternatives in the order they are +nat_min Unspecified r _ = trace' "Left Unspecified in nat_min\n"(r, False) -- leave the alternatives in the order they are +nat_min l Unspecified _ = trace' "Right Unspecified in nat_min\n"(l, False) -- leave the alternatives in the order they are nat_add :: Nat -> Nat -> Nat -nat_add Unspecified _ = Unspecified +nat_add Unspecified _ = trace' "Unspecified in add\n" Unspecified nat_add Infinite _ = trace' "Infinite in add\n" Infinite nat_add (Zero _) r = trace' "Zero in add\n" r nat_add (Succ l) r = trace' "Succ in add\n" (Succ (nat_add l r)) diff --git a/src/Text/ParserCombinators/UU/Demo/Examples.hs b/src/Text/ParserCombinators/UU/Demo/Examples.hs --- a/src/Text/ParserCombinators/UU/Demo/Examples.hs +++ b/src/Text/ParserCombinators/UU/Demo/Examples.hs @@ -14,7 +14,7 @@ import Data.Char import Text.ParserCombinators.UU import Text.ParserCombinators.UU.Utils -import Text.ParserCombinators.UU.BasicInstances +import Text.ParserCombinators.UU.BasicInstances hiding (Parser) import System.IO import GHC.IO.Handle.Types import qualified Data.ListLike as LL @@ -23,6 +23,8 @@ #define DEMO(p,i) demo "p" i p +type Parser a = P (Str Char String LineColPos) a + justamessage = "justamessage" -- | Running the function `show_demos` should give the following output: @@ -267,6 +269,6 @@ -demo :: Show r => String -> String -> Parser r -> IO () +demo :: Show r => String -> String -> P (Str Char String LineColPos) r -> IO () demo str input p= do putStr ("-- >>> run " ++ str ++ " " ++ show input ++ "\n") run p input diff --git a/src/Text/ParserCombinators/UU/Demo/MergeAndPermute.hs b/src/Text/ParserCombinators/UU/Demo/MergeAndPermute.hs --- a/src/Text/ParserCombinators/UU/Demo/MergeAndPermute.hs +++ b/src/Text/ParserCombinators/UU/Demo/MergeAndPermute.hs @@ -8,12 +8,12 @@ import Text.ParserCombinators.UU import Text.ParserCombinators.UU.MergeAndPermute -import Text.ParserCombinators.UU.BasicInstances +import Text.ParserCombinators.UU.BasicInstances hiding (Parser) import Text.ParserCombinators.UU.Utils import Text.ParserCombinators.UU.Demo.Examples hiding (show_demos) import qualified Data.ListLike as LL -type Grammar a = (IsLocationUpdatedBy loc Char, LL.ListLike state Char) => Gram (P (Str Char state loc)) a +type Grammar a = Gram (P (Str Char String LineColPos)) a -- | By running the function `show_demos` you will get a demonstration of the merging parsers. -- diff --git a/src/Text/ParserCombinators/UU/Derived.hs b/src/Text/ParserCombinators/UU/Derived.hs --- a/src/Text/ParserCombinators/UU/Derived.hs +++ b/src/Text/ParserCombinators/UU/Derived.hs @@ -13,7 +13,6 @@ module Text.ParserCombinators.UU.Derived where import Text.ParserCombinators.UU.Core -import Control.Applicative -- * Some aliases for oft occurring constructs diff --git a/src/Text/ParserCombinators/UU/Idioms.hs b/src/Text/ParserCombinators/UU/Idioms.hs --- a/src/Text/ParserCombinators/UU/Idioms.hs +++ b/src/Text/ParserCombinators/UU/Idioms.hs @@ -11,12 +11,18 @@ module Text.ParserCombinators.UU.Idioms where import Text.ParserCombinators.UU -import Text.ParserCombinators.UU.BasicInstances +import Text.ParserCombinators.UU.BasicInstances hiding (Parser) import Text.ParserCombinators.UU.Utils import Text.ParserCombinators.UU.Demo.Examples hiding (show_demos) import qualified Data.ListLike as LL import Control.Applicative +data IF = IF +data THEN = THEN +data ELSE = ELSE +data FI = FI + + data String' = String' {fromStr :: String} -- | The `Ii` is to be pronounced as @stop@ @@ -26,23 +32,24 @@ iI ::Idiomatic i (a -> a) g => g iI = idiomatic (pure id) - class Idiomatic st f g | g -> f st where idiomatic :: P st f -> g instance Idiomatic st x (Ii -> P st x) where idiomatic ix Ii = ix instance Idiomatic st f g => Idiomatic st (a -> f) (P st a -> g) where idiomatic isf is = idiomatic (isf <*> is) + + instance Idiomatic st f g => Idiomatic st ((a -> b) -> f) ((a -> b) -> g) where idiomatic isf f = idiomatic (isf <*> (pure f)) - instance (Idiomatic (Str Char state loc) f g, IsLocationUpdatedBy loc Char, LL.ListLike state Char) => Idiomatic (Str Char state loc) f (String -> g) where - idiomatic isf str = idiomatic (isf <* pToken str) + idiomatic isf str = idiomatic (isf <* lexeme (pToken str)) instance (Idiomatic (Str Char state loc) f g, IsLocationUpdatedBy loc Char, LL.ListLike state Char) => Idiomatic (Str Char state loc) f (Char -> g) where idiomatic isf c = idiomatic (isf <* pSym c) - +instance Idiomatic st f g => Idiomatic st (a -> f) (IF -> Bool -> THEN -> P st a -> ELSE -> P st a -> FI -> g) where + idiomatic isf IF b THEN t ELSE e FI = idiomatic (isf <*> (if b then t else e)) -- | The idea of the Idiom concept is that sequential composition operators can be inferred from the type -- of the various operands @@ -52,6 +59,9 @@ -- Correcting steps: -- Inserted ')' at position LineColPos 0 4 4 expecting one of [')', Whitespace, '0'..'9'] -- - +pNat :: Parser Int +pNat = pNatural -show_demos = demo "(iI (+) '(' pNatural \"plus\" pNatural ')' Ii)::Parser Int" "(2 plus 3)" ((iI (+) '(' pNatural "+" pNatural ')' Ii)::Parser Int) +show_demos :: IO () +show_demos = demo "(iI (+) '(' pNat \"plus\" IF True THEN pNat ELSE pNat FI ')' Ii) ::Parser Int" "(2 plus 3)" + ((iI (+) '(' pNat "plus" IF True THEN pNat ELSE pNat FI ')' Ii) ::Parser Int) diff --git a/src/Text/ParserCombinators/UU/MergeAndPermute.hs b/src/Text/ParserCombinators/UU/MergeAndPermute.hs --- a/src/Text/ParserCombinators/UU/MergeAndPermute.hs +++ b/src/Text/ParserCombinators/UU/MergeAndPermute.hs @@ -6,7 +6,6 @@ module Text.ParserCombinators.UU.MergeAndPermute where import Text.ParserCombinators.UU.Core -import Control.Applicative infixl 4 <||>, <<||> diff --git a/uu-parsinglib.cabal b/uu-parsinglib.cabal --- a/uu-parsinglib.cabal +++ b/uu-parsinglib.cabal @@ -1,5 +1,5 @@ Name: uu-parsinglib -Version: 2.7.0.2 +Version: 2.7.1 Build-Type: Simple License: MIT Copyright: S Doaitse Swierstra @@ -28,7 +28,7 @@ The file "Text.ParserCombinators.UU.README" contains some references to background information. . We maintain a low frequency mailing for discussing the package. You can subscribe at: -Category: Parsing Text +Category: Parsing, Text, Library hs-source-dirs: src