uu-parsinglib 2.4.4 → 2.5.0
raw patch · 5 files changed
+103/−50 lines, 5 files
Files
- src/Text/ParserCombinators/UU/BasicInstances.hs +38/−20
- src/Text/ParserCombinators/UU/CHANGELOG.hs +14/−0
- src/Text/ParserCombinators/UU/Core.hs +43/−22
- src/Text/ParserCombinators/UU/Examples.hs +7/−7
- uu-parsinglib.cabal +1/−1
src/Text/ParserCombinators/UU/BasicInstances.hs view
@@ -5,7 +5,8 @@ FlexibleInstances, FlexibleContexts, UndecidableInstances,- NoMonomorphismRestriction#-}+ NoMonomorphismRestriction,+ TypeSynonymInstances #-} -- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% -- %%%%%%%%%%%%% Some Instances %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%@@ -31,65 +32,82 @@ show_expecting (a:as) = " expecting one of [" ++ a ++ concat (map (", " ++) as) ++ "]" show_expecting [] = " expecting nothing" -data Str t = Str { input :: [t]- , msgs :: [Error Int ]- , pos :: !Int- , deleteOk :: !Bool}+data Str t loc = Str { input :: [t]+ , msgs :: [Error loc ]+ , pos :: loc+ , deleteOk :: !Bool} -listToStr ls = Str ls [] 0 True+listToStr ls initloc = Str ls [] initloc True -instance (Show a) => Provides (Str a) (a -> Bool, String, a) a where+type Parser a = P (Str Char (Int,Int)) a +instance IsLocationUpdatedBy (Int,Int) Char where+ advance (line,pos) c = case c of+ '\n' -> (line+1, 0) + '\t' -> (line , pos + 8 - (pos-1) `mod` 8)+ _ -> (line , pos + 1)++instance IsLocationUpdatedBy (Int,Int) String where+ advance = foldl advance ++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)) del exp = (5, splitState (p,msg, a) k- (Str (tail tts) (msgs ++ [Deleted (show(head tts)) pos exp]) (pos+1) True ))+ (Str (tail tts) + (msgs ++ [Deleted (show(head tts)) pos exp]) + (advance pos (head tts))+ True )) in case tts of (t:ts) -> if p t - then Step 1 (k t (Str ts msgs (pos + 1) True))+ then 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) => Provides (Str a) (a,a) a where+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) -instance (Eq a, Show a) => Provides (Str a) a a where+instance (Eq a, Show a, loc `IsLocationUpdatedBy` a) => Provides (Str a loc) a a where splitState a = splitState ((==a), show a, a) -instance Show a => Eof (Str a) where+instance Show a => Eof (Str a loc) where eof (Str i _ _ _ ) = null i deleteAtEnd (Str (i:ii) msgs pos ok ) = Just (5, Str ii (msgs ++ [DeletedAtEnd (show i)]) pos ok) deleteAtEnd _ = Nothing -instance Stores (Str a) (Error Int) where- getErrors (Str inp msgs pos ok ) = (msgs, Str inp [] pos ok)+instance Stores (Str a loc) (Error loc) where+ getErrors (Str inp msgs pos ok ) = (msgs, Str inp [] pos ok) +instance HasPosition (Str a loc) loc where+ getPos (Str inp msgs pos ok ) = pos+ -- pMunch data Munch a = Munch (a -> Bool) -instance (Show a) => Provides (Str a) (Munch a) [a] where - splitState (Munch p) k (Str tts msgs pos del_ok)+instance (Show a, loc `IsLocationUpdatedBy` [a]) => Provides (Str a loc) (Munch a) [a] where + splitState (Munch p) k inp@(Str tts msgs pos del_ok) = let (munched, rest) = span p tts l = length munched- in Step l (k munched (Str rest msgs (pos+l) (l>0 || del_ok)))+ in if l > 0 then Step l (k munched (Str rest msgs (advance pos munched) (l>0 || del_ok)))+ else k [] inp pMunch :: (Provides st (Munch a) [a]) => (a -> Bool) -> P st [a] pMunch p = pSymExt Zero (Just []) (Munch p) data Token a = Token [a] Int -- the Int value represents the cost for inserting such a token -instance (Show a, Eq a) => Provides (Str a) (Token a) [a] where +instance (Show a, Eq a, loc `IsLocationUpdatedBy` [a]) => Provides (Str a loc) (Token a) [a] where 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 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]) (pos+1) True ))+ 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 -> Step l (k as (Str rest msgs (pos+l) True))+ Just rest -> Step l (k as (Str rest msgs (advance pos as) True)) pToken as = pTokenCost as 5 pTokenCost as c = if null as then error "call to pToken with empty token"
src/Text/ParserCombinators/UU/CHANGELOG.hs view
@@ -1,4 +1,18 @@ -- | This module just contains the CHANGELOG+-- Version 2.5.0+-- +-- * generalised over the position in the input; now it is easy to maintain e.g. (line,column) info as shown in the "Examples.hs" file+--+-- * added needed instances for @String@ s as input in "BasicInstances.hs"+-- +-- * fixed a bug in pMunch where a Step was inserted with 0 progress, leading to infinite insertions +--+-- * added Haddock beautifications+--+-- Version 2.4.5+-- +-- * added the function @`pPos`@ for retreiving the current input position+-- -- Version 2.4.4 -- -- * solved a mistake which had crept in in the greedy choice
src/Text/ParserCombinators/UU/Core.hs view
@@ -35,7 +35,13 @@ eof :: state -> Bool deleteAtEnd :: state -> Maybe (Cost, state) +-- ** `Location` +-- | The input state may contain a location which can be used in error messages. Since we do not want to fix our input to be just a @String@ we provide an interface+-- which can be used to advance the location by passing its information in the function splitState +class loc `IsLocationUpdatedBy` a where+ advance::loc -> a -> loc+ -- * The type describing parsers: @`P`@ -- %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%@@ -94,6 +100,28 @@ Infinite Nothing +-- ** 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 comitted. Can be used to make parsers faster, and even+-- get a complete Parsec equivalent behaviour, with all its (dis)advantages. use with are!++P ph pf pr pl pe <<|> P qh qf qr ql qe + = let (rl, b) = nat_min pl ql+ bestx = if b then flip best else best+ in P ( \ k st -> let left = norm (ph k st) + in if has_success left then left+ else left `bestx` norm (qh k st))+ ( \ k st -> let left = norm (pf k st) + in if has_success left then left+ else left `bestx` norm (qf k st))+ ( \ k st -> let left = norm (pr k st) + in if has_success left then left+ else left `bestx` norm (qr k st))+ rl+ (case (pe, qe) of+ (Nothing, _ ) -> qe+ (_ , Nothing) -> pe+ (_ , _ ) -> error "ambiguous parser because two sides of choice can be empty")+ -- ** Parsers can recognise single tokens: @`pSym`@ and @`pSymExt`@ -- | Many parsing libraries do not make a distinction between the terminal symbols of the language recognised -- and the tokens actually constructed from the input. @@ -152,28 +180,7 @@ replaceExpected others = others --- ** 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 comitted. Can be used to make parsers faster, and even--- get a complete Parsec equivalent behaviour, with all its (dis)advantages. use with are! -P ph pf pr pl pe <<|> P qh qf qr ql qe - = let (rl, b) = nat_min pl ql- bestx = if b then flip best else best- in P ( \ k st -> let left = norm (ph k st) - in if has_success left then left- else left `bestx` norm (qh k st))- ( \ k st -> let left = norm (pf k st) - in if has_success left then left- else left `bestx` norm (qf k st))- ( \ k st -> let left = norm (pr k st) - in if has_success left then left- else left `bestx` norm (qr k st))- rl- (case (pe, qe) of- (Nothing, _ ) -> qe- (_ , Nothing) -> pe- (_ , _ ) -> error "ambiguous parser because two sides of choice can be empty")- -- ** Parsers can be disambiguated using micro-steps: @`micro`@ -- | `micro` inserts a `Cost` step into the sequence representing the progress the parser is making; for its use see `Text.ParserCombinators.UU.Examples` P ph pf pr pl pe `micro` i = P ( \ k st -> ph (\ a st -> Micro i (k a st)) st)@@ -208,7 +215,21 @@ ( \ k inp -> let (errs, inp') = getErrors inp in push errs (k inp')) ( \ k inp -> let (errs, inp') = getErrors inp in k inp' ) Zero -- this parser does not consume input- (Just []) -- the errors consumed cannot be determined statically! Hence we assume none.+ (Just (error "pErrors cannot occur in lhs of bind")) -- the errors consumed cannot be determined statically! ++-- ** The current position can be retreived from the state: @`pPos`@+-- | `pPos` retreives the correcting steps made since the last time the function was called. The result can, +-- using a monad, be used to control how to-- proceed with the parsing process.++class state `HasPosition` pos | state -> pos where+ getPos :: state -> pos++pPos :: HasPosition st pos => P st pos+pPos = P ( \ k inp -> let pos = getPos inp in k pos inp )+ ( \ k inp -> let pos = getPos inp in push pos (k inp))+ ( \ k inp -> let pos = getPos inp in k inp )+ Zero -- this parser does not consume input+ (Just (error "pPos cannot occur in lhs of bind")) -- the errors consumed cannot be determined statically! -- ** Starting and finalising the parsing process: @`pEnd`@ and @`parse`@ -- | The function `pEnd` should be called at the end of the parsing process. It deletes any unsonsumed input, and reports its preence as an eror.
src/Text/ParserCombinators/UU/Examples.hs view
@@ -1,4 +1,8 @@ {-# OPTIONS_HADDOCK ignore-exports #-}+{-# LANGUAGE FlexibleInstances,+ TypeSynonymInstances,+ MultiParamTypeClasses #-}+ module Text.ParserCombinators.UU.Examples where import Char import Text.ParserCombinators.UU.Core@@ -7,13 +11,9 @@ import Text.ParserCombinators.UU.Merge import Control.Monad --- |We start out by defining the type of parser we want; by specifying the type of the state we resolve a lot of overloading--type Parser a = P (Str Char) a - -- | The fuction @`run`@ runs the parser and shows both the result, and the correcting steps which were taken during the parsing process.-run :: Show t => P (Str Char) t -> String -> IO ()-run p inp = do let r@(a, errors) = parse ( (,) <$> p <*> pEnd) (listToStr inp)+run :: Show t => Parser t -> String -> IO ()+run p inp = do let r@(a, errors) = parse ( (,) <$> p <*> pEnd) (listToStr inp (0,0)) putStrLn "--" putStrLn ("-- > Result: " ++ show a) if null errors then return ()@@ -245,7 +245,7 @@ pKey keyw = pToken keyw `micro` 1 <* spaces spaces :: Parser String-spaces = pMunch (==' ')+spaces = pMunch (`elem` " \n") takes_second_alt = pList ident <|> (\ c t e -> ["IfThenElse"] ++ c ++ t ++ e)
uu-parsinglib.cabal view
@@ -1,5 +1,5 @@ Name: uu-parsinglib-Version: 2.4.4+Version: 2.5.0 Build-Type: Simple License: MIT Copyright: S Doaitse Swierstra