diff --git a/Text/GrammarCombinators/Parser/Packrat.hs b/Text/GrammarCombinators/Parser/Packrat.hs --- a/Text/GrammarCombinators/Parser/Packrat.hs +++ b/Text/GrammarCombinators/Parser/Packrat.hs @@ -89,61 +89,56 @@ type InternalPRRule phi r t v = Derivs phi r t -> Result phi r t v type InternalGrammar phi r t = forall ix. phi ix -> InternalPRRule phi r t (r ix) -data PackratRule phitop rtop phi ixT r t v = - PackratRule { - runParse :: InternalGrammar phitop rtop t -> - (forall ix. phi ix -> rtop (ApplyIxMap ixT ix) -> r ix) -> - (forall ix. phi ix -> phitop (ApplyIxMap ixT ix)) -> - InternalPRRule phitop rtop t v - } -type PackratGrammar phitop rtop phi ixT rr r t = forall ix. phi ix -> PackratRule phitop rtop phi ixT rr t (r ix) +data PackratRule phi r t v = + PackratRule { runParse :: InternalGrammar phi r t -> InternalPRRule phi r t v } -instance ProductionRule (PackratRule phitop rtop phi ixT r t) where - a >>> b = PackratRule $ \g rd si d0 -> - case runParse a g rd si d0 of - Parsed f d1 -> case runParse b g rd si d1 of +type PackratGrammar phi rr r t = forall ix. phi ix -> PackratRule phi rr t (r ix) + +instance ProductionRule (PackratRule phi r t) where + a >>> b = PackratRule $ \g d0 -> + case runParse a g d0 of + Parsed f d1 -> case runParse b g d1 of Parsed x d2 -> Parsed (f x) d2 _ -> NoParse _ -> NoParse -- TODO : parameterise disambiguation (keeping only 1st match or all)? - a ||| b = PackratRule $ \g rd si d -> - case runParse a g rd si d of + a ||| b = PackratRule $ \g d -> + case runParse a g d of Parsed v1 d1 -> Parsed v1 d1 - _ -> case runParse b g rd si d of + _ -> case runParse b g d of Parsed v2 d2 -> Parsed v2 d2 _ -> NoParse - die = PackratRule $ \_ _ _ _ -> NoParse - endOfInput = PackratRule $ \_ _ _ d -> + die = PackratRule $ \_ _ -> NoParse + endOfInput = PackratRule $ \_ d -> case unPRResult $ unDerivs d PackratDomainEndOfInput of Parsed _ d' -> Parsed () d' _ -> NoParse -instance EpsProductionRule (PackratRule phitop rtop phi ixT r t) where - epsilon v = PackratRule $ \_ _ _ -> Parsed v +instance EpsProductionRule (PackratRule phi r t) where + epsilon v = PackratRule $ \_ -> Parsed v -instance LiftableProductionRule (PackratRule phitop rtop phi ixT r t) where +instance LiftableProductionRule (PackratRule phi r t) where epsilonL v _ = epsilon v -instance (Token t) => TokenProductionRule (PackratRule phitop rtop phi ixT r t) t where - token c = PackratRule $ \_ _ _ d -> +instance (Token t) => TokenProductionRule (PackratRule phi r t) t where + token c = PackratRule $ \_ d -> case unPRResult$ unDerivs d PackratDomainPrimToken of Parsed v' d' | classify (unPRPrimTokenValue v') == c -> Parsed (unPRPrimTokenValue v') d' _ -> NoParse - anyToken = PackratRule $ \_ _ _ d -> + anyToken = PackratRule $ \_ d -> case unPRResult$ unDerivs d PackratDomainPrimToken of Parsed v' d' -> Parsed (unPRPrimTokenValue v') d' _ -> NoParse -instance RecProductionRule (PackratRule phitop rtop phi ixT r t) phi r where +instance RecProductionRule (PackratRule phi r t) phi r where ref (idx :: phi ix) = - PackratRule $ \grammar rd si d -> - fmap (rd idx) $ grammar (si idx) d + PackratRule $ \grammar d -> grammar idx d -toInternalGrammar :: PackratGrammar phi r phi IxMapId r r t -> InternalGrammar phi r t +toInternalGrammar :: PackratGrammar phi r r t -> InternalGrammar phi r t toInternalGrammar g idx = - runParse (g idx) (toInternalGrammar g) (\_ -> id) id + runParse (g idx) (toInternalGrammar g) parsePackratAll :: forall phi r t. (Token t, MemoFam phi) => InternalGrammar phi r t -> [ConcreteToken t] -> Derivs phi r t parsePackratAll grammar s = @@ -158,28 +153,7 @@ _ -> PRResult NoParse in buildDerivs derivs -instance SuperProductionRule (PackratRule phitop rtop) where - subref = prSubRef - -prSubRef :: forall phitop phi phi' rtop r ixT t ix supIxT . (DomainEmbedding phi phi' supIxT, HFunctor phi (PF phi)) => - (forall ix'. phi' ix' -> PackratRule phitop rtop phi' (IxMapSeq ixT supIxT) (SubVal supIxT r) t (PF phi' (SubVal supIxT r) ix')) -> - phi' ix -> phi (supIxT ix) -> - PackratRule phitop rtop phi ixT r t (PF phi r (supIxT ix)) -prSubRef subgram idxb idx = PackratRule $ \outgram rd supIxTop -> - let - subrule :: PackratRule phitop rtop phi' (IxMapSeq ixT supIxT) (SubVal supIxT r) t (PF phi' (SubVal supIxT r) ix) - subrule = subgram idxb - rd' :: forall ix' . phi' ix' -> rtop (ApplyIxMap ixT (supIxT ix')) -> SubVal supIxT r ix' - rd' idx' v = MkSubVal $ rd (supIx idx') v - supIx' :: forall ix' . phi' ix' -> phitop (ApplyIxMap ixT (supIxT ix')) - supIx' idx' = supIxTop (supIx idx' :: phi (supIxT ix')) - oprrule :: InternalPRRule phitop rtop t (PF phi' (SubVal supIxT r) ix) - oprrule = runParse subrule outgram rd' supIx' - nprrule :: InternalPRRule phitop rtop t (PF phi r (supIxT ix)) - nprrule = fmap (supPF idxb idx) . oprrule - in nprrule - -instance LoopProductionRule (PackratRule phitop rtop phi ixT r t) phi r where +instance LoopProductionRule (PackratRule phi r t) phi r where manyRef = manyInf . ref -- | Parse a given string according to a given grammar, starting from a given start non-terminal, diff --git a/Text/GrammarCombinators/Parser/RealLL1.hs b/Text/GrammarCombinators/Parser/RealLL1.hs --- a/Text/GrammarCombinators/Parser/RealLL1.hs +++ b/Text/GrammarCombinators/Parser/RealLL1.hs @@ -64,11 +64,12 @@ | SplitBranchSelectorMemoL (FirstSet t) (BranchSelectorMemo t) (BranchSelectorMemo t) | FlipBS (BranchSelectorMemo t) -unBranchSelectorMemo :: (Token t) => BranchSelectorMemo t -> BranchSelector t +unBranchSelectorMemo :: forall t. (Token t) => BranchSelectorMemo t -> BranchSelector t unBranchSelectorMemo DefaultBranchSelectorMemo = defaultBranchSelector unBranchSelectorMemo (SplitBranchSelectorMemoL fs bsm1 bsm2) = let bs1 = unBranchSelectorMemo bsm1 bs2 = unBranchSelectorMemo bsm2 + selBranch :: Set t -> Bool -> [ConcreteToken t] -> a -> a -> (a, BranchSelector t) selBranch fts _ (t:_) b1 b2 = if classify t `member` fts then (b1,bs1) else (b2,bs2) selBranch _ f [] b1 b2 = if f then (b1,bs1) else (b2,bs2) in MkBS $ selBranch (firstTokens fs) (canBeEOI fs) @@ -191,10 +192,12 @@ prepareLL1Parser :: (Domain phi, Token t) => BSCGrammar phi r t rr -> RealLL1Table phi t prepareLL1Parser gram = MkRealLL1Table $ toMemoK $ branchSelector . fixBSC gram -parseRealLL1 :: (Domain phi, Token t) => RealLL1Grammar phi ixT r r t -> RealLL1Table phi t -> +parseRealLL1 :: forall phi ixT t r ix. (Domain phi, Token t) => RealLL1Grammar phi ixT r r t -> RealLL1Table phi t -> phi ix -> [ConcreteToken t] -> Maybe (r ix) parseRealLL1 gram selgmemo idx s = let + selg :: phi ix' -> BranchSelector t selg = unBranchSelectorMemo . fromMemoK (unRealLL1Table selgmemo) + m :: MaybeT (State [ConcreteToken t]) (r ix) m = runLL1Rule (gram idx) (selg idx) selg gram in evalState (runMaybeT m) s diff --git a/Text/GrammarCombinators/Transform/FoldLoops.hs b/Text/GrammarCombinators/Transform/FoldLoops.hs --- a/Text/GrammarCombinators/Transform/FoldLoops.hs +++ b/Text/GrammarCombinators/Transform/FoldLoops.hs @@ -182,6 +182,6 @@ ProcessingExtendedContextFreeGrammar phi t r-> ProcessingContextFreeGrammar (FoldLoopsDomain phi) t (FoldLoopsValue r) foldAndProcessLoops gram = - let - loopsproc = processFoldLoops identityProcessor + let loopsproc :: FoldLoopsDomain phi ix -> FoldLoopsResultValue r r ix -> FoldLoopsValue r ix + loopsproc = processFoldLoops identityProcessor in applyProcessor (foldLoops gram) loopsproc diff --git a/Text/GrammarCombinators/Transform/LeftCorner.hs b/Text/GrammarCombinators/Transform/LeftCorner.hs --- a/Text/GrammarCombinators/Transform/LeftCorner.hs +++ b/Text/GrammarCombinators/Transform/LeftCorner.hs @@ -70,6 +70,7 @@ instance (Token t, FoldFam phi) => FoldFam (LCDomain phi t) where foldFam (f :: forall ix. LCDomain phi t ix -> b -> b) n = let n' = foldFam (f . LCBase) n + f' :: forall ix. phi ix -> b -> b f' idx = foldFam (f . (LCNTMinNT `flip` idx)) n'' = foldFam f' n' f'' tt = foldFam (f . LCNTMinT tt) @@ -103,14 +104,15 @@ instance (EqFam phi, Token t) => EqFam (LCDomain phi t) where overrideIdx f (LCBase idx) v (LCBase idx') = unSubVal $ overrideIdx (MkSubVal . f . LCBase) idx (MkSubVal v) idx' - overrideIdx (f :: forall ix. LCDomain phi t ix -> r ix) (LCNTMinNT idx idxm) v (LCNTMinNT idx' idxm') = + overrideIdx (f :: forall ix'. LCDomain phi t ix' -> r ix') (LCNTMinNT (idx :: phi ix) (idxm :: phi ixm)) v (LCNTMinNT idxr idxmr) = let - fc :: forall ix ixm. phi ix -> phi ixm -> r (LCNTMinNTIx ix ixm) - fc idx'' idxm'' = f $ LCNTMinNT idx'' idxm'' - fsect' idxm'' = unSubVal $ overrideIdx (MkSubVal . fc idx) idxm (MkSubVal v) idxm'' - fc' :: forall ix ixm. phi ix -> phi ixm -> r (LCNTMinNTIx ix ixm) - fc' idxm'' = unWFS $ overrideIdx (\idx'' -> WFS $ fc idx'') idx (WFS fsect') idxm'' - in fc' idx' idxm' + fc :: forall ix' ixm'. phi ix' -> phi ixm' -> r (LCNTMinNTIx ix' ixm') + fc idx' idxm' = f $ LCNTMinNT idx' idxm' + fsect' :: forall ix'. phi ix' -> r (LCNTMinNTIx ix ix') + fsect' idxm' = unSubVal $ overrideIdx (MkSubVal . fc idx) idxm (MkSubVal v) idxm' + fc' :: forall ix' ixm'. phi ix' -> phi ixm' -> r (LCNTMinNTIx ix' ixm') + fc' idxm' = unWFS $ overrideIdx (\idx' -> WFS $ fc idx') idx (WFS fsect') idxm' + in fc' idxr idxmr overrideIdx f (LCNTMinT tt idx) v (LCNTMinT tt' idx') = if tt == tt' then unSubVal $ overrideIdx (MkSubVal . f . LCNTMinT tt) idx (MkSubVal v) idx' @@ -138,17 +140,18 @@ EpsProductionRule p, RecProductionRule p (LCDomain phi t) (LCValue r t)) => ProductionRule (TransformLCRule p (LCDomain phi t) (LCValue r t) phi r t) where - ra >>> rb = + (ra :: TransformLCRule p (LCDomain phi t) (LCValue r t) phi r t (a -> b)) >>> rb = let es = tlcEmpty ra <*> tlcEmpty rb emptyA = maybe die epsilon $ tlcEmpty ra f = tlcFull ra >>> tlcFull rb + rNTMinNT :: phi ix' -> p (r ix' -> b) rNTMinNT idx' = flip $>> tlcNTMinNT ra idx' >>> tlcFull rb ||| (.) $>> emptyA >>> tlcNTMinNT rb idx' rNTMinT tt = flip $>> tlcNTMinT ra tt >>> tlcFull rb ||| (.) $>> emptyA >>> tlcNTMinT rb tt in MkTLCIR es f rNTMinNT rNTMinT - ra ||| rb = + (ra :: TransformLCRule p (LCDomain phi t) (LCValue r t) phi r t a) ||| rb = let es = case (tlcEmpty ra, tlcEmpty rb) of (Just _, Just _) -> error "Ambiguous: empty disjunction" @@ -156,6 +159,7 @@ (Nothing, Just vb) -> Just vb (Nothing, Nothing) -> Nothing f = tlcFull ra ||| tlcFull rb + rNTMinNT :: phi ix' -> p (r ix' -> a) rNTMinNT idx' = tlcNTMinNT ra idx' ||| tlcNTMinNT rb idx' rNTMinT tt = tlcNTMinT ra tt ||| tlcNTMinT rb tt in MkTLCIR es f rNTMinNT rNTMinT @@ -192,8 +196,9 @@ EpsProductionRule p, RecProductionRule p (LCDomain phi t) (LCValue r t)) => RecProductionRule (TransformLCRule p (LCDomain phi t) (LCValue r t) phi r t) phi r where - ref idx = + ref (idx :: phi ix) = let f = unLCBV $>> ref (LCBase idx) + rNTMinNT :: phi ix' -> p (r ix' -> r ix) rNTMinNT idxm = unWNTMinNTP $ overrideIdx (\_ -> WNTMinNTP die) idx (WNTMinNTP $ epsilon id) idxm in MkTLCIR Nothing f rNTMinNT (const die) @@ -206,11 +211,13 @@ manyRef (idx :: phi ix) = let f = map unLCBV $>> manyRef (LCBase idx) rNTMinNTIdx = flip (:) $>> (map unLCBV $>> manyRef (LCBase idx)) + rNTMinNT :: phi ix' -> p (r ix' -> [r ix]) rNTMinNT idxm = unWNTMinNTPs $ overrideIdx (\_ -> WNTMinNTPs die) idx (WNTMinNTPs rNTMinNTIdx) idxm in MkTLCIR Nothing f rNTMinNT (const die) many1Ref (idx :: phi ix) = let f = map unLCBV $>> many1Ref (LCBase idx) rNTMinNTIdx = flip (:) $>> (map unLCBV $>> manyRef (LCBase idx)) + rNTMinNT :: phi ix' -> p (r ix' -> [r ix]) rNTMinNT idxm = unWNTMinNTPs $ overrideIdx (\_ -> WNTMinNTPs die) idx (WNTMinNTPs rNTMinNTIdx) idxm in MkTLCIR Nothing f rNTMinNT (const die) @@ -230,16 +237,20 @@ ruleT tt = flip ($) $>> token tt >>> (unLCNTMinTV $>> ref (LCNTMinT tt idx)) ruleTs = LCBV $>> Set.fold ((|||) . ruleT) die fs in ruleTs -transformLeftCorner' bgram _ (LCNTMinT tt idx) = +transformLeftCorner' bgram _ (LCNTMinT tt (idx :: phi ix')) = let + bMinT :: phi ixB -> p (ConcreteToken t -> r ix') bMinT idxB = flip (.) $>> tlcNTMinT (bgram idxB) tt >>> (unLCNTMinNTV $>> ref (LCNTMinNT idxB idx)) bMinTs = foldFam ((|||) . bMinT) die in LCNTMinTV $>> bMinTs ||| LCNTMinTV $>> tlcNTMinT (bgram idx) tt -transformLeftCorner' bgram _ (LCNTMinNT idxm idx) = +transformLeftCorner' bgram _ (LCNTMinNT (idxm :: phi ixm) (idx :: phi ix')) = let + cMinB :: phi ixC -> p (LCValue r t (LCNTMinNTIx ixm ix')) cMinB idxC = LCNTMinNTV $>> (flip (.) $>> tlcNTMinNT (bgram idxC) idxm >>> follow idxC) + baseFollow :: phi ixC -> p (r ixC -> r ix') baseFollow idxC = unLCNTMinNTV $>> ref (LCNTMinNT idxC idx) + follow :: phi ixC -> p (r ixC -> r ix') follow idxC = unWNTMinNTP $ overrideIdx (WNTMinNTP . baseFollow) idx (WNTMinNTP $ baseFollow idx ||| epsilon id) idxC in -- flip (|||) produces alternatives in a better order, typically foldFam (flip (|||) . cMinB) die diff --git a/Text/GrammarCombinators/Transform/PenalizeErrors.hs b/Text/GrammarCombinators/Transform/PenalizeErrors.hs --- a/Text/GrammarCombinators/Transform/PenalizeErrors.hs +++ b/Text/GrammarCombinators/Transform/PenalizeErrors.hs @@ -98,7 +98,7 @@ allJustVs :: phi ix -> PF phi (MaybeSemanticT r) ix -> Bool allJustVs idx' pfv' = unIJA $ hmapA (\_ v -> IJA $ isJustV v) idx' pfv' fromJustVs :: phi ix -> PF phi (MaybeSemanticT r) ix -> PF phi r ix - fromJustVs = hmap (\_ (JustV v) -> v) + fromJustVs = hmap (\_ -> fromJustV) in if allJustVs idx pfv then JustV $ proc idx $ fromJustVs idx pfv else NothingV diff --git a/Text/GrammarCombinators/Transform/UnfoldRecursion.hs b/Text/GrammarCombinators/Transform/UnfoldRecursion.hs --- a/Text/GrammarCombinators/Transform/UnfoldRecursion.hs +++ b/Text/GrammarCombinators/Transform/UnfoldRecursion.hs @@ -121,22 +121,6 @@ ProcessingRegularGrammar phi t r unfoldRecursionE gram = unfoldRecursion (unfoldLoops gram) --- instance (ProductionRule p) => SuperProductionRule (RPWRule p) where --- subref subgram idxb = rpwSubRef (subgram idxb) idxb - --- rpwSubRef :: forall p phi phi' supIxT ixT r ix t . --- (DomainEmbedding phi phi' supIxT, HFunctor phi (PF phi), ProductionRule p) => --- RPWRule p phi' (IxMapSeq ixT supIxT) (SubVal supIxT r) t (PF phi' (SubVal supIxT r) ix) -> --- phi' ix -> phi (supIxT ix) -> --- RPWRule p phi ixT r t (PF phi r (supIxT ix)) --- rpwSubRef (RPWRule subintrule) idxb idx = RPWRule $ \outgram -> --- let --- restrictedGrammar :: forall ix'. phi' ix' -> p ((SubVal supIxT r) ix') --- restrictedGrammar idx' = epsilon MkSubVal >>> outgram (supIx idx') --- presult' :: p (PF phi' (SubVal supIxT r) ix) --- presult' = subintrule restrictedGrammar --- in epsilon (supPF idxb idx) >>> presult' - -- | A value of type UnfoldDepth defines for each non-terminal in a -- grammar how many times it should be unfolded by the 'unfoldSelective' -- or 'unfoldSelectiveE' algorithms. @@ -177,15 +161,15 @@ type RPWGrammar p phi ixT r v t = forall ix. phi ix -> RPWRule p phi ixT r t (v ix) -unfoldSelective' :: (EqFam phi, RecProductionRule p phi r) => +unfoldSelective' :: forall p phi ixT r t. (EqFam phi, RecProductionRule p phi r) => UnfoldDepth phi -> RPWGrammar p phi ixT r r t -> (forall ix. phi ix -> p (r ix)) -unfoldSelective' sel gram idx = - let - rg idx' = if sel idx' > 0 - then unfoldSelective' (modifyUnfoldDepth sel (flip (-) 1) idx') gram idx' - else ref idx' +unfoldSelective' sel gram idx = + let rg :: phi ix' -> p (r ix') + rg idx' = if sel idx' > 0 + then unfoldSelective' (modifyUnfoldDepth sel (flip (-) 1) idx') gram idx' + else ref idx' in unRPWRule (gram idx) rg -- | Selectively unfold a given context-free grammar according to a diff --git a/Text/GrammarCombinators/Transform/UniformPaull.hs b/Text/GrammarCombinators/Transform/UniformPaull.hs --- a/Text/GrammarCombinators/Transform/UniformPaull.hs +++ b/Text/GrammarCombinators/Transform/UniformPaull.hs @@ -146,15 +146,21 @@ MkTUPW $ \_ -> MkTUPIR (const False) (const $ Just $ epsilonL v q) (const die) (const [(True, epsilonL (const v) [| const $(q) |])]) $ epsilonL v q instance (ProductionRule p, LiftableProductionRule p) => ProductionRule (TransformUPWrapper p surrIx (UPDomain phi) (UPValue r) phi ixT r t) where - ra >>> rb = MkTUPW $ \g -> + (ra :: TransformUPWrapper p surrIx (UPDomain phi) (UPValue r) phi ixT r t (a -> b)) >>> + rb = MkTUPW $ \g -> let (MkTUPIR rlaa eas ha tas fa) = tUPRuleForGrammar ra g (MkTUPIR rlab ebs hb tbs fb) = tUPRuleForGrammar rb g + rla :: phi ix -> Bool rla idx = rlaa idx || ((isJust $ eas idx) && rlab idx) + es :: phi ix -> Maybe (p b) es idx = liftM2 (>>>) (eas idx) (ebs idx) + hForEmptyA :: phi ix -> p b hForEmptyA idx = case eas idx of Nothing -> die Just rea -> rea >>> hb idx + h :: phi ix -> p b h idx = hForEmptyA idx ||| ha idx >>> fb + ts :: phi surrIx -> [(Bool, p (r surrIx -> b))] ts surrIdx = do (ea, ta) <- tas surrIdx if ea @@ -163,11 +169,14 @@ else return (False, epsilonL flip [| flip |] >>> ta >>> fb) f = fa >>> fb in MkTUPIR rla es h ts f - ra ||| rb = MkTUPW $ \g -> + (ra :: TransformUPWrapper p surrIx (UPDomain phi) (UPValue r) phi ixT r t a) ||| rb = MkTUPW $ \g -> let (MkTUPIR rlaa eas ha tas fa) = tUPRuleForGrammar ra g (MkTUPIR rlab ebs hb tbs fb) = tUPRuleForGrammar rb g + rla :: phi ix -> Bool rla idx = rlaa idx || rlab idx + es :: phi ix -> Maybe (p a) es idx = liftM2 (|||) (eas idx) (ebs idx) + h :: phi ix -> p a h idx = ha idx ||| hb idx ts surrIdx = tas surrIdx ++ tbs surrIdx in MkTUPIR rla es h ts $ fa ||| fb @@ -184,9 +193,11 @@ instance (PenaltyProductionRule p) => PenaltyProductionRule (TransformUPWrapper p surrIx (UPDomain phi) (UPValue r) phi ixT r t) where - penalty p r = MkTUPW $ \g -> + penalty p (r :: TransformUPWrapper p surrIx (UPDomain phi) (UPValue r) phi ixT r t a) = MkTUPW $ \g -> let (MkTUPIR rla es h ts f) = tUPRuleForGrammar r g + es' :: phi ix -> Maybe (p a) es' idx = liftM (penalty p) (es idx) + h' :: phi ix -> p a h' idx = penalty p (h idx) in MkTUPIR rla es' h' ts $ penalty p f @@ -244,6 +255,7 @@ (hForEmptyHead idx' ||| ha idx') >>> tlclTailRef idx else f + es :: forall ix'. phi ix' -> Maybe (p (r ix)) es idx' = if rla idx' -- use True to turn off optimization then eas idx' else Nothing diff --git a/Text/GrammarCombinators/Utils/ToGraph.hs b/Text/GrammarCombinators/Utils/ToGraph.hs --- a/Text/GrammarCombinators/Utils/ToGraph.hs +++ b/Text/GrammarCombinators/Utils/ToGraph.hs @@ -171,8 +171,5 @@ gr String String reachableGrammarToGraph depth gram idx = grammarToGraph (foldReachable gram idx) depth gram -void :: (Monad m) => m a -> m () -void m = m >> return () - showGraph :: (DotRepr dg n) => dg n -> IO () showGraph gr = void $ runGraphvizCanvas' gr Xlib diff --git a/Text/GrammarCombinators/Utils/UnfoldDepthFirst.hs b/Text/GrammarCombinators/Utils/UnfoldDepthFirst.hs --- a/Text/GrammarCombinators/Utils/UnfoldDepthFirst.hs +++ b/Text/GrammarCombinators/Utils/UnfoldDepthFirst.hs @@ -41,8 +41,7 @@ many1Ref' :: phi ix -> p (rr ix) -> p [r ix] newtype UnfoldDepthFirstRule p (phi :: * -> *) (r :: * -> *) t (rr :: * -> *) v = MkFRR { - foldReachableFromRule :: UDFGrammar p phi r t rr -> - p v + foldReachableFromRule :: UDFGrammar p phi r t rr -> p v } type UDFGrammar p phi r t rr = @@ -137,7 +136,7 @@ SimpleLoopProductionRule p phi r rr) => GAnyExtendedContextFreeGrammar phi t r rr -> phi ix -> p (rr ix) -unfoldDepthFirstProper grammar = unfoldDepthFirst' grammar id +unfoldDepthFirstProper grammar = unfoldDepthFirst' grammar (\g -> g) unfoldDepthFirst :: forall p phi r rr t ix. (ProductionRule p, EqFam phi, @@ -149,5 +148,5 @@ SimpleLoopProductionRule p phi r rr) => GAnyExtendedContextFreeGrammar phi t r rr -> phi ix -> p (r ix) -unfoldDepthFirst grammar idx = unfoldDepthFirst'' (ref idx) grammar id +unfoldDepthFirst grammar idx = unfoldDepthFirst'' (ref idx) grammar (\g -> g) diff --git a/changelog b/changelog new file mode 100644 --- /dev/null +++ b/changelog @@ -0,0 +1,4 @@ +-*-change-log-*- + +0.2.2 Dominique Devriese Jan 2011 + * Make it compile with GHC 7 diff --git a/grammar-combinators.cabal b/grammar-combinators.cabal --- a/grammar-combinators.cabal +++ b/grammar-combinators.cabal @@ -1,5 +1,5 @@ Name: grammar-combinators -Version: 0.2.1 +Version: 0.2.2 Description: The grammar-combinators library is a novel parsing library using an explicit representation of recursion to provide various novel @@ -14,7 +14,7 @@ Category: Parsing Synopsis: A parsing library of context-free grammar combinators. Cabal-Version: >=1.2.1 -Extra-Source-Files: COPYING.GPL +Extra-Source-Files: COPYING.GPL, changelog Stability: experimental Library