UnfoldChainNTs.hs

{-  Copyright 2010 Dominique Devriese

    This file is part of the grammar-combinators library.

    The grammar-combinators library is free software: you can
    redistribute it and/or modify it under the terms of the GNU
    Lesser General Public License as published by the Free
    Software Foundation, either version 3 of the License, or (at
    your option) any later version.

    Foobar is distributed in the hope that it will be useful, but
    WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
    GNU Lesser General Public License for more details.

    You should have received a copy of the GNU Lesser General
    Public License along with Foobar. If not, see
    <http://www.gnu.org/licenses/>.
-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Text.GrammarCombinators.Transform.UnfoldChainNTs (
  unfoldChainNTs,
  unfoldChainNTsE
  ) where

import Text.GrammarCombinators.Base

import Text.GrammarCombinators.Utils.IsChainNT
import Text.GrammarCombinators.Transform.UnfoldRecursion 
import Text.GrammarCombinators.Transform.UnfoldLoops

-- | Unfold chain non-terminals in a given context-
-- free grammar.
-- A chain non-terminal is a terminal such that its
-- production rule is a numer of epsilons followed by a 
-- single normal reference to another non-terminal.
unfoldChainNTs :: forall phi r t. (EqFam phi) => 
  ProcessingContextFreeGrammar phi r t -> 
  ProcessingContextFreeGrammar phi r t 
unfoldChainNTs gram idx =
  let 
    gram' :: ProcessingContextFreeGrammar phi r t
    gram' idx' = if isChainNT (unfoldChainNTs gram) idx'
                then unfoldChainNTs gram idx'
                else ref idx'
  in unfoldRule (gram idx) gram'

data RuleToManyWrapper p (phi :: * -> *) (r :: * -> *) t v =
  RTMEps v |
  RTMW { ruleToManyRule :: p [v], 
         ruleToMany1Rule :: p [v] }

instance (ProductionRule p, EpsProductionRule p) =>
         ProductionRule (RuleToManyWrapper p phi r t) where
  (RTMEps va) >>> (RTMEps vb) = RTMEps $ va vb
  (RTMEps va) >>> (RTMW rmb rm1b) = RTMW (map va $>> rmb) (map va $>> rm1b)
  (RTMW rma rm1a) >>> (RTMEps vb) = RTMW (map ($ vb) $>> rma) (map ($ vb) $>> rm1a)
  (RTMW _ _ ) >>> (RTMW _ _) = RTMW die die
  _ ||| _ = RTMW die die
  die = RTMW die die
  endOfInput = RTMW die die

instance (ProductionRule p, EpsProductionRule p) => EpsProductionRule (RuleToManyWrapper p phi r t) where
  epsilon = RTMEps

instance (ProductionRule p, EpsProductionRule p) => LiftableProductionRule (RuleToManyWrapper p phi r t) where
  epsilonL v _ = RTMEps v

instance (ProductionRule p) => TokenProductionRule (RuleToManyWrapper p phi r t) t where
  token _ = RTMW die die
  anyToken = RTMW die die

instance (LoopProductionRule p phi r) =>
         RecProductionRule (RuleToManyWrapper p phi r t) phi r where
  ref idx = RTMW (manyRef idx) (many1Ref idx)

instance (ProductionRule p, EpsProductionRule p, LoopProductionRule p phi r) =>
         LoopProductionRule (RuleToManyWrapper p phi r t) phi r where
  manyRef _ = RTMW die die
  many1Ref _ = RTMW die die

-- | Unfold chain non-terminals in a given extended 
-- context-free grammar.
-- A chain non-terminal is a terminal such that its
-- production rule is a numer of epsilons followed by a 
-- single normal reference to another non-terminal.
unfoldChainNTsE :: forall phi r t. (EqFam phi) => 
  ProcessingExtendedContextFreeGrammar phi r t -> 
  ProcessingExtendedContextFreeGrammar phi r t 
unfoldChainNTsE gram idx =
  let gramm' idx' = if isChainNT (unfoldChainNTsE gram) idx'
                   then ruleToManyRule (unfoldChainNTsE gram idx')
                   else manyRef idx'
      gramm1' idx' = if isChainNT (unfoldChainNTsE gram) idx'
                    then ruleToMany1Rule (unfoldChainNTsE gram idx')
                    else many1Ref idx'
      gram' :: ProcessingExtendedContextFreeGrammar phi r t
      gram' idx' = if isChainNT (unfoldChainNTsE gram) idx'
                  then unfoldChainNTsE gram idx'
                  else ref idx'
  in replaceLoopsRule (unfoldRuleE (gram idx) gram') gramm' gramm1'

-- TODO: unfold chain rules -> useful?