uu-parsinglib 2.8.1.1 → 2.9.0
raw patch · 5 files changed
+103/−64 lines, 5 filesdep ~basedep ~uu-interleaved
Dependency ranges changed: base, uu-interleaved
Files
- src/Text/ParserCombinators/UU/BasicInstances.hs +5/−5
- src/Text/ParserCombinators/UU/CHANGELOG.hs +4/−0
- src/Text/ParserCombinators/UU/Core.hs +79/−53
- src/Text/ParserCombinators/UU/Derived.hs +10/−0
- uu-parsinglib.cabal +5/−6
src/Text/ParserCombinators/UU/BasicInstances.hs view
@@ -44,7 +44,7 @@ import Text.ParserCombinators.UU.Core import Data.Maybe import Data.Word-import Debug.Trace+-- import Debug.Trace import qualified Data.ListLike as LL -- * `Error`@@ -142,7 +142,7 @@ -- and the second parameter how to proceed in case an element recognised by this parser is absent, -- and parsing may proceed by pretending such an element was present in the input anayway. pSatisfy :: forall loc state a .((Show a, loc `IsLocationUpdatedBy` a, LL.ListLike state a) => (a -> Bool) -> (Insertion a) -> P (Str a state loc) a)-pSatisfy p (Insertion msg a cost) = pSymExt splitState (Succ (Zero Infinite)) Nothing+pSatisfy p (Insertion msg a cost) = pSymExt splitState (Succ (Zero)) Nothing where splitState :: forall r. ((a -> (Str a state loc) -> Steps r) -> (Str a state loc) -> Steps r) splitState k (Str tts msgs pos del_ok) = show_attempt ("Try Predicate: " ++ msg ++ " at position " ++ show pos ++ "\n") (@@ -179,7 +179,7 @@ -- | `pMunchL` recognises the longest prefix of the input for which the passed predicate holds. The message parameter 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 (Zero Infinite) Nothing+pMunchL p msg = pSymExt splitState Zero 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") (@@ -202,7 +202,7 @@ else pSymExt splitState (nat_length as) Nothing where tas :: state tas = LL.fromList as- nat_length [] = Zero Infinite+ nat_length [] = Zero nat_length (_:as) = Succ (nat_length as) l = length as msg = show as @@ -224,7 +224,7 @@ ) pToken :: forall loc state a .((Show a, Eq a, loc `IsLocationUpdatedBy` a, LL.ListLike state a) => [a] -> P (Str a state loc) [a])-pToken as = pTokenCost as 5+pToken as = pTokenCost as 10 {-# INLINE show_tokens #-}
src/Text/ParserCombinators/UU/CHANGELOG.hs view
@@ -1,4 +1,8 @@ -- | This module just contains the CHANGELOG+-- Version 2.8.2+--+-- Change in the internal Steps data type in order to get correct behaviour when-- inserting at end of file+-- -- -- Version 2.7.4.1 --
src/Text/ParserCombinators/UU/Core.hs view
@@ -3,7 +3,8 @@ MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, - KindSignatures #-}+ KindSignatures,+ CPP #-} -- | The module `Core` contains the basic functionality of the parser library. -- It defines the types and implementations of the elementary parsers and recognisers involved. @@ -53,8 +54,12 @@ import Control.Applicative import Control.Monad import Data.Char-import Debug.Trace-import Prelude hiding ((.))+-- import Debug.Trace+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 710+import Prelude hiding ((.), traverse)+#else+ import Prelude hiding ((.))+#endif import Data.Maybe f . g = \x -> f ( g x)@@ -181,7 +186,7 @@ getOneP :: P a b -> Maybe (P a b) -- getOneP (P _ (Just _) (Zero Unspecified) _ ) = error "The element is a special parser which cannot be combined" getOneP (P _ Nothing _ l) = Nothing-getOneP (P _ onep ep l) = Just( mkParser onep Nothing (getLength l))+getOneP (P _ onep ep l) = Just( mkParser onep Nothing l) -- | `getZeroP` retrieves the possibly empty part from a descriptor. getZeroP :: P t a -> Maybe a@@ -192,7 +197,7 @@ mkParser np ne l = P (mkParser' np ne) np ne l 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+ mkParser' np@(Just nt) ne@(Just a) = pure a <|> nt mkParser' np@(Nothing) ne@(Nothing) = empty -- ! `combine` creates the non-empty parser @@ -200,9 +205,10 @@ -> (t1 -> t -> f a) -> (t2 -> t3 -> f a) -> Maybe (f a) combine Nothing Nothing _ _ _ _ = Nothing -- this Parser always fails combine (Just p) Nothing aq _ op1 op2 = Just (p `op1` aq) -combine (Just p) (Just v) aq nq op1 op2 = case nq of- Just nnq -> Just (p `op1` aq <|> v `op2` nnq)- Nothing -> Just (p `op1` aq ) -- rhs contribution is just from empty alt+combine (Just p) (Just v) aq nq op1 op2 = Just (case nq of+ Just nnq -> p `op1` aq <|> v `op2` nnq+ Nothing -> p `op1` aq -- rhs contribution is just from empty alt+ ) combine Nothing (Just v) _ nq _ op2 = case nq of Just nnq -> Just (v `op2` nnq) -- right hand side has non-empty part Nothing -> Nothing -- neither side has non-empty part@@ -212,25 +218,29 @@ f <$ (P ap np me l) = P (f <$ ap) (fmap (f <$) np) (f <$ me) l instance Applicative (P state) where- P ap np pe pl <*> ~(P aq nq qe ql) = trace' "<*>" (mkParser (combine np pe aq nq (<*>) (<$>)) (pe <*> qe) (nat_add pl ql))- P ap np pe pl <* ~(P aq nq qe ql) = trace' "<* " (mkParser (combine np pe aq nq (<*) (<$)) (pe <* qe ) (nat_add pl ql))- P ap np pe pl *> ~(P aq nq qe ql) = trace' " *>" (mkParser (combine np pe aq nq (*>) (flip const)) (pe *> qe ) (nat_add pl ql)) - pure a = trace' "pure" (mkParser Nothing (Just a ) (Zero Infinite))+ P ap np pe pl <*> ~(P aq nq qe ql) = trace'' "<*>" (mkParser (combine np pe aq nq (<*>) (<$>)) (pe <*> qe) (nat_add pl ql))+ P ap np pe pl <* ~(P aq nq qe ql) = trace'' "<* " (mkParser (combine np pe aq nq (<*) (<$)) (pe <* qe ) (nat_add pl ql))+ P ap np pe pl *> ~(P aq nq qe ql) = trace'' " *>" (mkParser (combine np pe aq nq (*>) (flip const)) (pe *> qe ) (nat_add pl ql)) + pure a = trace'' "pure" (mkParser Nothing (Just a) Zero) instance Alternative (P state) where - P ap np pe pl <|> P aq nq qe ql - = let pl' = maybe pl (const (Zero pl)) pe- ql' = maybe ql (const (Zero ql)) qe- (rl, b) = trace' "calling natMin from <|>" (nat_min pl' ql' 0)+ (P ap np pe pl) <|> (P aq nq qe ql) + = let pl' = maybe pl (const Zero) pe+ ql' = maybe ql (const Zero) qe+ (rl', b) = trace' "calling natMin from <|>" (nat_min pl' ql' 0)+ (rl, _) = nat_min pl ql 0 Nothing `alt` q = q p `alt` Nothing = p- Just p `alt` Just q = Just (p <|>q)+ Just p `alt` Just q = Just (p <|> q) in mkParser ((if b then id else flip) alt np nq) (pe <|> qe) rl empty = mkParser empty empty Infinite instance ExtAlternative (P st) where- P ap np pe pl <<|> P aq nq qe ql - = let (rl, b) = nat_min pl ql 0+ ~(P ap np pe pl) <<|> ~(P aq nq qe ql) + = let pl' = maybe pl (const Zero) pe+ ql' = maybe ql (const Zero) qe+ (rl', b) = nat_min pl' ql' 0+ (rl, _) = nat_min pl ql 0 bestx :: Steps a -> Steps a -> Steps a bestx = (if b then id else flip) best choose:: T st a -> T st a -> T st a@@ -253,10 +263,10 @@ ( \ k inp -> replaceExpected (norm ( pf k inp))) ( \ k inp -> replaceExpected (norm ( pr k inp)))) in mkParser nnp pe pl- must_be_non_empty msg p@(P _ _ _ (Zero _)) _ - = error ("The combinator " ++ msg ++ " requires that it's argument cannot recognise the empty string\n")+ must_be_non_empty msg p@(P _ _ (Just _) _) _ + = error ("The combinator " ++ msg ++ " requires that its argument cannot recognise the empty string\n") must_be_non_empty _ _ q = q- must_be_non_empties msg (P _ _ _ (Zero _)) (P _ _ _ (Zero _)) _ + must_be_non_empties msg (P _ _ (Just _) _) (P _ _ (Just _) _) _ = error ("The combinator " ++ msg ++ " requires that not both arguments can recognise the empty string\n") must_be_non_empties _ _ _ q = q @@ -327,21 +337,21 @@ pErrors = let nnp = Just (T ( \ k inp -> let (errs, inp') = getErrors inp in k errs inp' ) ( \ k inp -> let (errs, inp') = getErrors inp in push errs (k inp')) ( \ k inp -> let (errs, inp') = getErrors inp in k inp' ))- in mkParser nnp Nothing (Zero Infinite)+ in mkParser nnp Nothing Zero -- | `pPos` returns the current input position. pPos :: HasPosition st pos => P st pos pPos = let nnp = Just ( T ( \ k inp -> let pos = getPos inp in k pos inp ) ( \ k inp -> let pos = getPos inp in push pos (k inp)) ( \ k inp -> k inp ))- in mkParser nnp Nothing (Zero Infinite)+ in mkParser nnp Nothing Zero -- | `pState` returns the current input state pState :: P st st pState = let nnp = Just ( T ( \ k inp -> k inp inp) ( \ k inp -> push inp (k inp)) ($))- in mkParser nnp Nothing (Zero Infinite) + in mkParser nnp Nothing Zero -- | The function `pEnd` should be called at the end of the parsing process. It deletes any unconsumed input, turning it into error messages. @@ -361,7 +371,7 @@ in (k finalstate) Just (i, inp') -> Fail [] [const (i, deleterest inp')] in deleterest inp))- in mkParser nnp Nothing (Zero Infinite)+ in mkParser nnp Nothing Zero -- | @`pSwitch`@ takes the current state and modifies it to a different type of state to which its argument parser is applied. -- The second component of the result is a function which converts the remaining state of this parser back into a value of the original type.@@ -382,16 +392,16 @@ -- | The function @`parse`@ shows the prototypical way of running a parser on -- some specific input.--- By default we use the future parser, since this gives us access to partal+-- By default we use the future parser, since this gives us access to partial -- result; future parsers are expected to run in less space. parse :: (Eof t) => P t a -> t -> a-parse (P (T _ pf _) _ _ _) = fst . eval . pf (\ rest -> if eof rest then Step 0 ( Step 0 (Step 0 (Step 0 (Step 0 (error "ambiguous parser?"))))) - else error "pEnd missing?")+parse (P (T _ pf _) _ _ _) state = fst . eval $ pf (\ rest -> if eof rest then Done ()+ else error "pEnd missing?") state -- | The function @`parse_h`@ behaves like @`parse`@ but using the history -- parser. This parser does not give online results, but might run faster. parse_h :: (Eof t) => P t a -> t -> a-parse_h (P (T ph _ _) _ _ _) = fst . eval . ph (\ a rest -> if eof rest then push a (Step 0 (Step 0 (Step 0 (Step 0 (Step 0 (error "ambiguous parser?"))))) )- else error "pEnd missing?") +parse_h (P (T ph _ _) _ _ _) state = eval $ ph (\ a rest -> if eof rest then Done a+ else error "pEnd missing?") state -- | The data type `Steps` is the core data type around which the parsers are constructed. -- It describes a tree structure of streams containing (in an interleaved way) both the online result of the parsing process,@@ -418,10 +428,20 @@ Step :: Progress -> Steps a -> Steps a Apply :: forall a b. (b -> a) -> Steps b -> Steps a Fail :: Strings -> [Strings -> (Cost , Steps a)] -> Steps a- Micro :: Int -> Steps a -> Steps a+ Micro :: Int -> Steps a -> Steps a+ Done :: a -> Steps a End_h :: ([a] , [a] -> Steps r) -> Steps (a,r) -> Steps (a, r) End_f :: [Steps a] -> Steps a -> Steps a +instance Show (Steps a) where+ show (Step _ _) = "Step"+ show (Apply _ _) = "Apply"+ show (Fail _ _) = "Fail"+ show (Micro _ _) = "Micro"+ show (Done _) = "Done"+ show (End_h _ _ ) = "End_h"+ show (End_f _ _ ) = "End_f"+ type Cost = Int type Progress = Int type Strings = [String]@@ -435,20 +455,13 @@ apply2fst :: (b -> a) -> Steps (b, r) -> Steps (a, r) apply2fst f = Apply (\ br -> let (b, r) = br in (f b, r)) -{--succeedAlways :: Steps a-succeedAlways = let steps = Step 0 steps in steps--failAlways :: Steps a-failAlways = Fail [] [const (0, failAlways)]--}- noAlts :: Steps a noAlts = Fail [] [] has_success :: Steps t -> Bool has_success (Step _ _) = True-has_success _ = False +has_success (Done _) = True+has_success _ = False -- | @`eval`@ removes the progress information from a sequence of steps, -- and constructs the value embedded in it.@@ -464,6 +477,7 @@ eval (Apply f l ) = f (eval l) eval (End_f _ _ ) = error "dangling End_f constructor" eval (End_h _ _ ) = error "dangling End_h constructor"+eval (Done a ) = a -- | `norm` makes sure that the head of the sequence contains progress information. -- It does so by pushing information about the result (i.e. the `Apply` steps) backwards.@@ -475,6 +489,7 @@ norm (Apply f (Apply g l )) = norm (Apply (f.g) l) norm (Apply f (End_f ss l )) = End_f (map (Apply f) ss) (Apply f l) norm (Apply f (End_h _ _ )) = error "Apply before End_h"+norm (Apply f (Done a )) = Done (f a) norm steps = steps applyFail :: (c -> d) -> [a -> (b, c)] -> [a -> (b, d)]@@ -485,6 +500,9 @@ x `best` y = norm x `best'` norm y best' :: Steps b -> Steps b -> Steps b+(Done _) `best'` (Done _) = error "ambiguous parsers"+l@(Done _) `best'` r = l+l `best'` r@(Done _) = r End_f as l `best'` End_f bs r = End_f (as++bs) (l `best` r) End_f as l `best'` r = End_f as (l `best` r) l `best'` End_f bs r = End_f bs (l `best` r)@@ -504,7 +522,7 @@ | i == j = Micro i (l `best` r) | i < j = ls | i > j = rs-l `best'` r = error "missing alternative in best'" +l `best'` r = error ("missing alternative in best': " ++ show l ++ " " ++ show r) -- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -- %%%%%%%%%%%%% getCheapest %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%@@ -531,6 +549,7 @@ ) traverse n (End_h ((a, lf)) r) v c = traverse n (lf a `best` removeEnd_h r) v c traverse n (End_f (l :_) r) v c = traverse n (l `best` r) v c+traverse n (Done _ ) v c = trace' ("traverse at Done" ++ show' 0 v c ++ " choosing" ++ show v ++ "\n") 0 show' :: (Show a, Show b, Show c) => a -> b -> c -> String show' n v c = "n: " ++ show n ++ " v: " ++ show v ++ " c: " ++ show c@@ -546,6 +565,7 @@ removeEnd_h (Apply f l ) = error "not in history parsers" removeEnd_h (Micro c l ) = Micro c (removeEnd_h l) removeEnd_h (End_h (as, k_st ) r ) = k_st as `best` removeEnd_h r +removeEnd_h (Done _) = error "spurious End_h at Done" removeEnd_f :: Steps r -> Steps [r] removeEnd_f (Fail m ls) = Fail m (applyFail removeEnd_f ls)@@ -556,32 +576,35 @@ removeEnd_f (End_f(s:ss) r) = Apply (:(map eval ss)) s `best` removeEnd_f r+removeEnd_f (Done _) = error "spurious End_f at Done" -- ** The type @`Nat`@ for describing the minimal number of tokens consumed -- | The data type @`Nat`@ is used to represent the minimal length of a parser. -- Care should be taken in order to not evaluate the right hand side of the binary function @`nat-add`@ more than necesssary. -data Nat = Zero Nat -- the length of the non-zero part of the parser is remembered)+data Nat = Zero | Succ Nat | Infinite | Unspecified | Hole deriving Show +{- -- | `getlength` retrieves the length of the non-empty part of a parser getLength :: Nat -> Nat getLength (Zero l) = l getLength l = l+-} addLength n (P t nep e l) = P t nep e (addLength' n l) addLength' :: Int -> Nat -> Nat-addLength' n (Zero _) = fromInt n+addLength' n Zero = fromInt n addLength' n (Succ m) = Succ (addLength' n m) addLength' n Infinite = Infinite addLength' n Unspecified = Unspecified addLength' n Hole = fromInt n -fromInt n = if n>= 0 then (n `times` Succ) (Zero undefined) else error "error: negative argument passed to addlength"+fromInt n = if n>= 0 then (n `times` Succ) Zero else error "error: negative argument passed to addlength" where times :: Int -> (Nat -> Nat) -> Nat -> Nat times 0 _ v = v times n f v = times (n-1) f (f v)@@ -592,11 +615,9 @@ nat_min :: Nat -> Nat -> Int -> ( Nat -- the actual minimum length , Bool -- whether alternatives should be swapped ) -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)- in (Zero m, False))+nat_min Zero Zero n = trace' "Both Zero in nat_min\n" (Zero , False) +nat_min l rr@Zero n = trace' "Right Zero in nat_min\n" (Zero , True)+nat_min ll@Zero r n = trace' "Left Zero in nat_min\n" (Zero, False) nat_min (Succ ll) (Succ rr) n = if n > 1000 then error "problem with comparing lengths" else trace' ("Succ in nat_min " ++ show n ++ "\n") (let (v, b) = nat_min ll rr (n+1) in (Succ v, b))@@ -609,7 +630,7 @@ nat_add :: Nat -> Nat -> Nat-nat_add (Zero _) r = trace' "Zero in add\n" r+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)) nat_add Infinite _ = trace' "Infinite in add\n" Infinite nat_add Hole _ = Hole@@ -618,5 +639,10 @@ trace' :: String -> b -> b-trace' m v = {- trace m -} v--- trace' m v = trace m v +trace' m v = v+-- trace' m v = trace m v++trace'' :: String -> b -> b+trace'' m v = v+--trace'' m v = trace m v +
src/Text/ParserCombinators/UU/Derived.hs view
@@ -47,6 +47,16 @@ p <??> q = must_be_non_empty "<??>" q (p <**> (q `opt` id)) +-- | `<.>` functional composition of two parsers+--+(<.>) :: IsParser p => p (b -> c) -> p (a -> b) -> p (a -> c)+f <.> g = (.) <$> f <*> g++-- | `<..>` functional composition of two parsers with the arguments reversed+--+(<..>) :: IsParser p => p (a -> b) -> p (b -> c) -> p (a -> c)+g <..> f = (.) <$> f <*> g+ infixl 4 <??>
uu-parsinglib.cabal view
@@ -1,5 +1,5 @@ Name: uu-parsinglib-Version: 2.8.1.1+Version: 2.9.0 Build-Type: Simple License: MIT Copyright: S Doaitse Swierstra @@ -9,11 +9,10 @@ Stability: stable, but evolving Homepage: http://www.cs.uu.nl/wiki/bin/view/HUT/ParserCombinators Bug-reports: mailto:doaitse@swierstra.net -Synopsis: Fast, online, error-correcting, monadic, applicative, merging, permuting, idiomatic parser combinators.+Synopsis: Fast, online, error-correcting, monadic, applicative, merging, permuting, interleaving, idiomatic parser combinators. Description: New version of the Utrecht University parser combinator library, which provides online, error correction, - annotation free, applicative style parser combinators. In addition to this we do provide a monadic and idomatic interface.- Parsers do analyse themselves to avoid commonly made errors. A recent addition was the combinator @`<||>`@ and - associates, which generalise merging and permuting parsers.+ annotation free, applicative style parser combinators. In addition to this we provide a monadic and an idomatic interface.+ Parsers do analyse themselves to avoid commonly made errors. . This version is based on the module "Data.Listlike", and as a result a great variety of input structures (@Strings@, @ByteStrings@, etc.) can be handled.@@ -40,7 +39,7 @@ Library hs-source-dirs: src - Build-Depends: base >= 4.2 && <5, time, ListLike >= 3.0.1, uu-interleaved >= 0.1.0 && < 0.2+ Build-Depends: base >= 4.2 && <5, time, ListLike >= 3.0.1, uu-interleaved >= 0.1.0 && < 0.3 Exposed-modules: Text.ParserCombinators.UU Text.ParserCombinators.UU.CHANGELOG