uu-parsinglib 2.5.5.2 → 2.5.6
raw patch · 5 files changed
+51/−22 lines, 5 files
Files
- src/Text/ParserCombinators/UU/BasicInstances.hs +18/−10
- src/Text/ParserCombinators/UU/CHANGELOG.hs +5/−1
- src/Text/ParserCombinators/UU/Core.hs +15/−6
- src/Text/ParserCombinators/UU/Derived.hs +12/−4
- uu-parsinglib.cabal +1/−1
src/Text/ParserCombinators/UU/BasicInstances.hs view
@@ -54,7 +54,8 @@ instance (Show a, loc `IsLocationUpdatedBy` a) => Provides (Str a loc) (a -> Bool, String, a) a where splitState (p, msg, a) k (Str tts msgs pos del_ok) - = let ins exp = (5, k a (Str tts (msgs ++ [Inserted (show a) pos exp]) pos False))+ = show_attempt ("Try Predicate: " ++ msg ++ "\n") (+ let ins exp = (5, k a (Str tts (msgs ++ [Inserted (show a) pos exp]) pos False)) del exp = (5, splitState (p,msg, a) k (Str (tail tts) @@ -67,6 +68,7 @@ (Step 1 (k t (Str ts msgs (advance pos t) True))) else Fail [msg] (ins: if del_ok then [del] else []) [] -> Fail [msg] [ins]+ ) instance (Ord a, Show a, loc `IsLocationUpdatedBy` a) => Provides (Str a loc) (a,a) a where splitState a@(low, high) = splitState (\ t -> low <= t && t <= high, show low ++ ".." ++ show high, low)@@ -92,11 +94,13 @@ instance (Show a, loc `IsLocationUpdatedBy` [a]) => Provides (Str a loc) (Munch a) [a] where splitState (Munch p x) k inp@(Str tts msgs pos del_ok)- = let (munched, rest) = span p tts+ = show_attempt ("Try Munch: " ++ x ++ "\n") (+ let (munched, rest) = span p tts l = length munched in if l > 0 then show_munch ("Accepting munch: " ++ x ++ " " ++ show munched ++ show pos ++ "\n") (Step l (k munched (Str rest msgs (advance pos munched) (l>0 || del_ok))))- else show_munch ("Accepting munch: " ++ x ++ " " ++ show munched ++ show pos ++ "\n") (k [] inp)+ else show_munch ("Accepting munch: " ++ x ++ " as emtty munch " ++ show pos ++ "\n") (k [] inp)+ ) pMunch :: (Provides st (Munch a) [a]) => (a -> Bool) -> P st [a] pMunch p = pSymExt Zero Nothing (Munch p "") -- the empty case is handled above@@ -109,13 +113,15 @@ splitState tok@(Token as cost) k (Str tts msgs pos del_ok) = let l = length as msg = show as - in case stripPrefix as tts of+ in show_attempt ("Try Token: " ++ show as ++ "\n") (+ case stripPrefix as tts of Nothing -> let ins exp = (cost, k as (Str tts (msgs ++ [Inserted msg pos exp]) pos False)) del exp = (5, splitState tok k (Str (tail tts) (msgs ++ [Deleted (show(head tts)) pos exp]) (advance pos [(head tts)]) True )) in if null tts then Fail [msg] [ins] else Fail [msg] (ins: if del_ok then [del] else []) Just rest -> show_tokens ("Accepting token: " ++ show as ++"\n") (Step l (k as (Str rest msgs (advance pos as) True)))+ ) pToken :: (Provides state (Token a) token) => [a] -> P state token pToken as = pTokenCost as 5@@ -124,11 +130,13 @@ where length [] = Zero length (_:as) = Succ (length as) -show_tokens :: a -> b -> b-show_tokens m v = {- trace m -} v+show_tokens :: String -> b -> b+show_tokens m v = {- trace m -} v -show_munch :: a -> b -> b-show_munch m v = {- trace m -} v+show_munch :: String -> b -> b+show_munch m v = {- trace m -} v -show_symbol :: a -> b -> b-show_symbol m v = {- trace m -} v+show_symbol :: String -> b -> b+show_symbol m v = {- trace m -} v++show_attempt m v = {- trace m -} v
src/Text/ParserCombinators/UU/CHANGELOG.hs view
@@ -1,4 +1,8 @@ -- | This module just contains the CHANGELOG+-- Version 2.5.6+--+-- * added a special version of \<|\> (called '<-|->') in @ExtAlternative@ which does not compare the length of the parsers; to be used in permutations+-- -- Version 2.5.5.2 -- -- * type signatures were added to make Haddock happy@@ -7,7 +11,7 @@ -- -- * type signatures were added to make the library GHC 7 ready. ------- Version 2.5.5+-- Version 2.5.5 -- -- * preference is given to earlier accept steps in order to avoid infinite insertions in case of otherwise equivalent repair strategies --
src/Text/ParserCombinators/UU/Core.hs view
@@ -18,7 +18,7 @@ infix 2 <?> -- should be the last element in a sequence of alternatives infixl 3 <<|> -- intended use p <<|> q <<|> r <|> x <|> y <?> z-+infixl 3 <-|-> -- an alternative for <|> which does not compare the lengths, to be used in permutation parsers -- ** `Provides' @@ -43,8 +43,10 @@ -- ** An extension to @`Alternative`@ which indicates a biased choice -- | In order to be able to describe greedy parsers we introduce an extra operator, whch indicates a biased choice-class ExtAlternative p where- (<<|>) :: p a -> p a -> p a+class (Alternative p) => ExtAlternative p where+ (<<|>) :: p a -> p a -> p a+ (<-|->) :: p a -> p a -> p a+ (<-|->) = (<|>) -- * The triples containg a history, a future parser and a recogniser: @`T`@@@ -166,7 +168,7 @@ in let nnp = (if b then (nq `alt` np) else (np `alt` nq)) nep = if b then trace' "calling pe" pe else trace' "calling qe" qe in P (mkParser nnp nep) nnp rl nep- empty = P empty empty Infinite Nothing+ empty = P empty empty Infinite Nothing -- the always failing parser! -- ** An alternative for the Alternative, which is greedy: @`<<|>`@ -- | `<<|>` is the greedy version of `<|>`. If its left hand side parser can make some progress that alternative is committed. Can be used to make parsers faster, and even@@ -189,6 +191,13 @@ (maybe np (\nqq -> maybe nq (\npp -> return( choose npp nqq)) np) nq) rl (pe <|> qe) -- due to the way Maybe is instance of Alternative the left hand operator gets priority+ P ap np pl pe <-|-> P aq nq ql qe + = let Nothing `alt` q = q+ p `alt` Nothing = p+ Just p `alt` Just q = Just (p <|>q)+ in let nnp = np `alt` nq+ nep = pe <|> qe+ in P (mkParser nnp nep) nnp pl nep -- ** Parsers can recognise single tokens: @`pSym`@ and @`pSymExt`@ -- Many parsing libraries do not make a distinction between the terminal symbols of the language recognised @@ -578,8 +587,8 @@ get_length :: P a b -> Nat get_length (P _ _ l _) = l -trace' :: a -> b -> b-trace' m v = {- trace m -} v +trace' :: String -> b -> b+trace' m v = {- trace m -} v
src/Text/ParserCombinators/UU/Derived.hs view
@@ -190,18 +190,26 @@ oneAlt (Many p, others) = (p, Many p : others) oneAlt (Opt p, others) = (p, others) +toParser' :: [ Freq (P st (d -> d)) ] -> P st (d -> d)+toParser' [] = pure id+toParser' alts = let palts = [(.) <$> p <*> toParser' ps | (p,ps) <- split alts id]+ in if and (map canBeEmpty alts) + then foldr (<|>) (pure id) palts+ else foldr1 (<|>) palts+ toParser :: [ Freq (P st (d -> d)) ] -> P st d -> P st d toParser [] units = units toParser alts units = let palts = [p <*> toParser ps units | (p,ps) <- split alts id] in if and (map canBeEmpty alts) - then foldr (<|>) units palts- else foldr1 (<|>) palts+ then foldr (<-|->) units palts+ else foldr1 (<-|->) palts + toParserSep :: [Freq (P st (b -> b))] -> P st a -> P st b -> P st b toParserSep alts sep units = let palts = [p <*> toParser (map (fmap (sep *>)) ps) units | (p,ps) <- split alts id] in if and (map canBeEmpty alts) - then foldr (<|>) units palts- else foldr1 (<|>) palts+ then foldr (<-|->) units palts+ else foldr1 (<-|->) palts newtype MergeSpec p = MergeSpec p
uu-parsinglib.cabal view
@@ -1,5 +1,5 @@ Name: uu-parsinglib-Version: 2.5.5.2+Version: 2.5.6 Build-Type: Simple License: MIT Copyright: S Doaitse Swierstra