gll 0.3.0.0 → 0.3.0.1
raw patch · 6 files changed
+105/−66 lines, 6 files
Files
- gll.cabal +3/−2
- src/GLL/Combinators/Interface.hs +33/−18
- src/GLL/Combinators/Options.hs +16/−16
- src/GLL/Parseable/Char.hs +11/−0
- src/GLL/Parser.hs +40/−20
- src/GLL/Types/Grammar.hs +2/−10
gll.cabal view
@@ -3,7 +3,7 @@ -- The name of the package. name: gll-version: 0.3.0.0+version: 0.3.0.1 synopsis: GLL parser with simple combinator interface license: BSD3 license-file: LICENSE@@ -12,7 +12,7 @@ category: Compilers build-type: Simple cabal-version: >=1.8-tested-with: GHC == 7.6.3+tested-with: GHC == 7.4.1, GHC == 7.8.3, GHC == 7.10.1 copyright: Copyright (C) 2015 L. Thomas van Binsbergen stability: experimental description: @@ -47,6 +47,7 @@ , GLL.Combinators.Test.Interface , GLL.Combinators , GLL.Parser+ , GLL.Parseable.Char other-modules : GLL.Types.Abstract , GLL.Combinators.Memoisation , GLL.Combinators.Options
src/GLL/Combinators/Interface.hs view
@@ -201,11 +201,17 @@ Token(..), Parseable(..), -- * Running a parser parse,- -- ** Running a parser with disambiguation options+ -- ** Running a parser with options parseWithOptions, -- *** Possible options- Options, Option, leftBiased, maximumPivot, maximumPivotAtNt,+ CombinatorOptions, CombinatorOption, leftBiased, maximumPivot, maximumPivotAtNt, GLL.Combinators.Options.maximumErrors, throwErrors,+ -- **** Parser options+ fullSPPF, allNodes, packedNodesOnly, strictBinarisation,+ -- *** Running a parser with options and explicit failure+ parseWithOptionsAndError,+ -- ** Runing a parser to obtain 'ParseResult'.+ parseResult, parseResultWithOptions,ParseResult(..), -- * Derived combinators mkNt, -- *** Ignoring semantic results@@ -225,7 +231,7 @@ import GLL.Combinators.Visit.Grammar import GLL.Combinators.Memoisation import GLL.Types.Abstract-import GLL.Parser hiding (parse, parseWithOptions)+import GLL.Parser hiding (parse, parseWithOptions, Options, Option, runOptions) import qualified GLL.Parser as GLL import Control.Arrow@@ -255,9 +261,9 @@ -- | A list of alternatives represents the right-hand side of a rule. type AltExprs = OO [] AltExpr -parse' :: (Show t, Parseable t, IsSymbExpr s) => +parse' :: (Show t, Parseable t, IsSymbExpr s) => ParseOptions -> PCOptions -> s t a -> [t] -> (Grammar t, ParseResult t, Either String [a])-parse' opts p' input = +parse' popts opts p' input = let SymbExpr (Nt start,vpa2,vpa3) = mkRule ("__Start" <:=> OO [id <$$> p']) snode = (start, 0, m) m = length input@@ -265,21 +271,16 @@ as = vpa3 opts IM.empty sppf arr 0 m grammar = (start, [ p | (_, alts) <- M.assocs rules, p <- alts ]) max_err = max_errors opts- parse_res = GLL.parseWithOptions [strictBinarisation, packedNodesOnly, GLL.maximumErrors max_err] grammar input+ parse_res = GLL.parseWithOptions (popts++[GLL.maximumErrors max_err]) grammar input sppf = sppf_result parse_res arr = A.array (0,m) (zip [0..] input) in (grammar, parse_res, if res_success parse_res then Right $ unsafePerformIO as else Left (error_message parse_res) ) --- | The grammar of a given parser+-- | The grammar of a given parser. grammar :: (Show t, Parseable t, IsSymbExpr s) => s t a -> Grammar t-grammar p = (\(f,_,_) -> f) (parse' defaultOptions p [])---- | Get the SPPF produced by parsing the given input with the given parser-sppf :: (Show t, Parseable t, IsSymbExpr s) => - s t a -> [t] -> ParseResult t-sppf p str = (\(_,s,_) -> s) $ parse' defaultOptions p str+grammar p = (\(f,_,_) -> f) (parse' defaultPOpts defaultOptions p []) -- | -- Runs a parser given a string of 'Parseable's and returns a list of @@ -288,21 +289,35 @@ parse = parseWithOptions [] -- | --- Run the parser with some 'Options'.+-- Run the parser with some 'CombinatorOptions'. parseWithOptions :: (Show t, Parseable t, IsSymbExpr s) => - Options -> s t a -> [t] -> [a]+ CombinatorOptions -> s t a -> [t] -> [a] parseWithOptions opts p ts = case parseWithOptionsAndError opts p ts of Left str | throw_errors opts' -> error str | otherwise -> [] Right as -> as where opts' = runOptions opts+ -- | --- Run the parser with some 'Options' and return either an error or the results.+-- Run the parser with some 'CombinatorOptions' and return either an error or the results. -- Any returned results will be a list of length greater than 0. parseWithOptionsAndError :: (Show t, Parseable t, IsSymbExpr s) => - Options -> s t a -> [t] -> Either String [a]-parseWithOptionsAndError opts p = (\(_,_,t) -> t) . parse' (runOptions opts) p+ CombinatorOptions -> s t a -> [t] -> Either String [a]+parseWithOptionsAndError opts p = (\(_,_,t) -> t) . parse' defaultPOpts (runOptions opts) p++-- | Get the 'ParseResult', containing an 'SPPF', +-- produced by parsing the given input with the given parser.+parseResult :: (Show t, Parseable t, IsSymbExpr s) => s t a -> [t] -> ParseResult t+parseResult = parseResultWithOptions [] [] ++-- | Get the 'ParseResult' given some 'ParseOptions' and 'CombinatorOptions'. +parseResultWithOptions :: (Show t, Parseable t, IsSymbExpr s) => + ParseOptions -> CombinatorOptions -> s t a -> [t] -> ParseResult t+parseResultWithOptions popts opts p str = + (\(_,s,_) -> s) $ parse' popts (runOptions opts) p str++defaultPOpts = [strictBinarisation, packedNodesOnly] infixl 2 <:=> -- |
src/GLL/Combinators/Options.hs view
@@ -2,51 +2,51 @@ import Data.Function (on) --- | Options datatype+-- | CombinatorOptions datatype -- * left_biased_choice: see function leftBiased -- * pivot_select: provide a filtering function on `pivots' data PCOptions = PCOptions { left_biased_choice :: Bool , pivot_select :: Maybe (Int -> Int -> Ordering) , pivot_select_nt :: Bool- , max_errors :: Int , throw_errors :: Bool , do_memo :: Bool+ , max_errors :: Int } --- | A list of 'Option's for evaluating combinator expressions.-type Options = [Option]+-- | A list of 'CombinatorOption's for evaluating combinator expressions.+type CombinatorOptions = [CombinatorOption] -- | A single option.-type Option = PCOptions -> PCOptions+type CombinatorOption = PCOptions -> PCOptions -runOptions :: [Option] -> PCOptions+runOptions :: CombinatorOptions -> PCOptions runOptions = foldr ($) defaultOptions -- | The default options: no disambiguation. defaultOptions :: PCOptions-defaultOptions = PCOptions False Nothing False 3 False False+defaultOptions = PCOptions False Nothing False False False 3 -- | Enables a 'longest-match' at production level.-maximumPivot :: Option+maximumPivot :: CombinatorOption maximumPivot opts = opts {pivot_select = Just compare} -- | Enables a 'shortest-match' at production level.-minimumPivot :: Option+minimumPivot :: CombinatorOption minimumPivot opts = opts {pivot_select = Just (flip compare)} -- | Enables 'longest-match' at non-terminal level. -maximumPivotAtNt :: Option+maximumPivotAtNt :: CombinatorOption maximumPivotAtNt opts = opts {pivot_select_nt = True, pivot_select = Just compare} -- | -- Set the maximum number of errors shown in case of an unsuccessful parse.-maximumErrors :: Int -> Option-maximumErrors n flags = flags {max_errors = n}+maximumErrors :: Int -> CombinatorOption+maximumErrors n opts = opts { max_errors = n } -- | -- If there are no parse results, the default behaviour is to return an empty list. -- If this option is used, a runtime error will be reported, with debugging information.-throwErrors :: Option+throwErrors :: CombinatorOption throwErrors opts = opts{throw_errors = True} @@ -54,12 +54,12 @@ -- Turns all occurrences of '<||>' into a 'left biased' variant: -- only return results of the second alternate if the first alternate -- does not have any results.-leftBiased :: Option+leftBiased :: CombinatorOption leftBiased opts = opts { left_biased_choice = True } -- | --- Whether to use unsafe memoisation to speed up the enumeration of parse results-useMemoisation :: Option+-- Whether to use unsafe memoisation to speed up the enumeration of parse results.+useMemoisation :: CombinatorOption useMemoisation opts = opts { do_memo = True } -- | Filter a list such that the only remaining elements are equal to
+ src/GLL/Parseable/Char.hs view
@@ -0,0 +1,11 @@++-- | Exports an instance for 'Parseable' 'Char' +-- that sssumes '$' and '#' never appear in the inpur string.+module GLL.Parseable.Char () where++import GLL.Types.Abstract++-- | Assumes '$' and '#' never appear in the inpur string.+instance Parseable Char where+ eos = '$'+ eps = '#'
src/GLL/Parser.hs view
@@ -165,14 +165,16 @@ parse, -- ** Run the GLL parser with options parseWithOptions,- -- *** Options+ -- *** ParseOptions+ ParseOptions, ParseOption, strictBinarisation, fullSPPF, allNodes, packedNodesOnly, maximumErrors, -- ** Result- ParseResult(..), SPPF(..), SPPFNode(..), SymbMap, ImdMap, PackMap, EdgeMap, + ParseResult(..), SPPF(..), SPPFNode(..), SymbMap, ImdMap, PackMap, EdgeMap, showSPPF, ) where import Data.Foldable hiding (forM_, toList, sum)-import Prelude hiding (lookup, foldr, fmap, foldl, elem)+import Prelude hiding (lookup, foldr, fmap, foldl, elem, any)+import Control.Applicative import Control.Monad import qualified Data.IntMap as IM import qualified Data.Map as M@@ -303,31 +305,45 @@ (GLL m') = f a in m' o p' +-- | Flags to influence the behaviour of the parser. data Flags = Flags { symbol_nodes :: Bool , intermediate_nodes :: Bool , edges :: Bool , flexible_binarisation :: Bool , max_errors :: Int }-defaultOptions = Flags False False False True 3-runOptions = foldr ($) defaultOptions -type Option = Flags -> Flags-type Options = [Option]+-- | The default flags:+-- * Do not add symbol nodes to the 'SPPF'.+-- * Do not add intermediate nodes to the 'SPPF'.+-- * Do not add edges to the 'SPPF'.+-- * Flexible binarisation.+-- * The three furthest discoveries of a token mismatch are reported. +defaultFlags = Flags False False False True 3 +-- | Execute the given 'Options' in left-to-right order on 'defaultFlags'.+runOptions :: ParseOptions -> Flags+runOptions = foldr ($) defaultFlags++-- | An option updates the current set of 'Flags'.+type ParseOption = Flags -> Flags++-- | A list of 'ParserOption's+type ParseOptions = [ParseOption]+ -- | -- Create the 'SPPF' with all nodes and edges, not necessarily strictly binarised.-fullSPPF :: Option+fullSPPF :: ParseOption fullSPPF flags = flags{symbol_nodes = True, intermediate_nodes = True, edges = True} -- | -- Create all nodes, but no edges between nodes.-allNodes :: Option+allNodes :: ParseOption allNodes flags = flags{symbol_nodes = True, intermediate_nodes = True} -- | -- Create packed-nodes only.-packedNodesOnly :: Option+packedNodesOnly :: ParseOption packedNodesOnly flags = flags{symbol_nodes = False, intermediate_nodes = False, edges = False} -- | @@ -335,12 +351,12 @@ -- When this flag is on, packed nodes can only have a single symbol node child -- or one intermediate node child and one symbol node child. -- With the flag disabled a packed node can have two symbol node children.-strictBinarisation :: Option+strictBinarisation :: ParseOption strictBinarisation flags = flags{flexible_binarisation = False} -- | -- Set the maximum number of errors shown in case of an unsuccessful parse.-maximumErrors :: Int -> Option+maximumErrors :: Int -> ParseOption maximumErrors n flags = flags {max_errors = n} -- | @@ -357,7 +373,7 @@ -- -- * only packed nodes are created -- * the resulting 'SPPF' is not strictly binarised-parseWithOptions :: Parseable t => [Option] -> Grammar t -> [t] -> ParseResult t+parseWithOptions :: Parseable t => ParseOptions -> Grammar t -> [t] -> ParseResult t parseWithOptions opts grammar@(start,_) str = let flags = runOptions opts (mutable,_,_,_) = gll flags m False grammar input@@ -480,7 +496,8 @@ data ParseResult t = ParseResult{ sppf_result :: SPPF t , res_success :: Bool , nr_descriptors :: Int- , nr_symbol_nodes :: Int+ , nr_nterm_nodes :: Int+ , nr_term_nodes :: Int , nr_intermediate_nodes :: Int , nr_packed_nodes :: Int , nr_sppf_edges :: Int@@ -496,7 +513,7 @@ usize = sum [ S.size s | (l, r2s) <- IM.assocs u , (r,s) <- IM.assocs r2s ] s_nodes = sum [ S.size s | (l, r2s) <- IM.assocs sMap- , (r, s) <- IM.assocs r2s ] + m+ , (r, s) <- IM.assocs r2s ] i_nodes = sum [ S.size s | (l, r2s) <- IM.assocs iMap , (r, s) <- IM.assocs r2s ] p_nodes = sum [ IS.size ks | (l, r2j) <- IM.assocs pMap@@ -508,7 +525,7 @@ gss_edges = 1 + sum [ length s | (l,x2s) <- IM.assocs gss , (x,s) <- M.assocs x2s ] sppf@(sMap, iMap, pMap, eMap) = mut_sppf mutable- in ParseResult sppf (mut_success mutable) usize s_nodes i_nodes p_nodes sppf_edges gss_nodes gss_edges (renderErrors inp flags (mut_mismatches mutable))+ in ParseResult sppf (mut_success mutable) usize s_nodes m i_nodes p_nodes sppf_edges gss_nodes gss_edges (renderErrors inp flags (mut_mismatches mutable)) renderErrors :: Show t => Input t -> Flags -> MisMatches t -> String renderErrors inp flags mm = render doc @@ -525,14 +542,17 @@ ppExp = text . show instance Show (ParseResult t) where- show res | res_success res = unlines $- [ "Descriptors: " ++ show (nr_descriptors res)- , "Symbol nodes: " ++ show (nr_symbol_nodes res)+ show res | res_success res = result_string+ | otherwise = result_string ++ "\n" ++ error_message res+ where result_string = unlines $+ [ "Success " ++ show (res_success res)+ , "Descriptors: " ++ show (nr_descriptors res)+ , "Nonterminal nodes: " ++ show (nr_nterm_nodes res)+ , "Terminal nodes: " ++ show (nr_term_nodes res) , "Intermediate nodes: " ++ show (nr_intermediate_nodes res) , "Packed nodes: " ++ show (nr_packed_nodes res) , "SPPF edges: " ++ show (nr_sppf_edges res) , "GSS nodes: " ++ show (nr_gss_nodes res) , "GSS edges: " ++ show (nr_gss_edges res) ]- | otherwise = error_message res
src/GLL/Types/Grammar.hs view
@@ -169,16 +169,8 @@ showS sMap = unlines [ show (l,r) ++ " --> " ++ show (sset) | (l,r2s) <- IM.assocs sMap, (r,sset) <- IM.assocs r2s] -- TODO change to Map-showSPPF :: (Show t) => ([(SNode t,PNode t)],[(PNode t,SNode t)]) -> String-showSPPF (se,pe) = "\n"++ (unlines $ map ppPn $ pe) ++ "\n" ++- (unlines $ map ppSn $ se)- where ppPn ((Prod x alpha, rs), sn) = ppRhs (x,alpha,rs) ++ " --> " ++ show sn- ppSn (sn, (Prod x alpha, rs)) = show sn ++ " --> " ++ ppRhs (x,alpha,rs)- ppRhs (x, alpha, rs) = "(" ++ x ++ " ::= "++ (foldr ((++) . ppS) "" alpha) ++ - foldr (\i -> (("," ++ show i) ++)) "" rs ++ ")"- ppS (Nt s) = s- ppS (Term t) = show t-+showSPPF :: Show t => SPPF t -> String +showSPPF (_,_,pMap,_) = showP pMap -- smart constructors nT x = Nt x