CombineEpsilons.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 FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Text.GrammarCombinators.Transform.CombineEpsilons (
  combineEpsilons,
  combineEpsilonsE
  ) where

import Text.GrammarCombinators.Base

data CombineEpsilonsRule p (phi :: * -> *) (r :: * -> *) t v where
    CERule :: (v' -> v) -> p v' -> CombineEpsilonsRule p phi r t v
    CEEpsRule :: v -> CombineEpsilonsRule p phi r t v

instance (ProductionRule p, EpsProductionRule p) =>
         ProductionRule (CombineEpsilonsRule p phi r t) where
  endOfInput = CERule id endOfInput
  (CEEpsRule va) >>> (CEEpsRule vb) = CEEpsRule $ va vb
  (CEEpsRule va) >>> (CERule fb rb) = CERule (va . fb) rb
  (CERule fa ra) >>> (CEEpsRule vb) = CERule (flip ($) vb . fa)  ra
  (CERule fa ra) >>> (CERule fb rb) = CERule (uncurry fa) ((\va vb -> (va, fb vb)) $>> ra >>> rb) 
  ra ||| rb = CERule id $ runCERule ra ||| runCERule rb
  die = CERule id die

instance (EpsProductionRule p) => EpsProductionRule (CombineEpsilonsRule p phi r t) where
  epsilon = CEEpsRule

instance (EpsProductionRule p) => LiftableProductionRule (CombineEpsilonsRule p phi r t) where
  epsilonL v _ = CEEpsRule v

instance (TokenProductionRule p t) =>
         TokenProductionRule (CombineEpsilonsRule p phi r t) t where
  token = CERule id . token
  anyToken = CERule id anyToken

instance (RecProductionRule p phi r) =>
         RecProductionRule (CombineEpsilonsRule p phi r t) phi r where
  ref = CERule id . ref

instance (EpsProductionRule p, LoopProductionRule p phi r) =>
         LoopProductionRule (CombineEpsilonsRule p phi r t) phi r where
  manyRef = CERule id . manyRef
  many1Ref = CERule id . many1Ref

runCERule :: (ProductionRule p, EpsProductionRule p) =>
             CombineEpsilonsRule p phi r t v -> p v
runCERule (CERule f r) = f $>> r
runCERule (CEEpsRule v) = epsilon v

-- | Combine consecutive epsilon rules in a given grammar into a single
-- epsilon rule.
combineEpsilons :: forall phi t r rr. 
  GContextFreeGrammar phi t r rr ->
  GContextFreeGrammar phi t r rr
combineEpsilons gram idx = runCERule $ gram idx

-- | Combine consecutive epsilon rules in a given extended 
-- grammar into a single epsilon rule.
combineEpsilonsE :: forall phi t r rr. 
  GExtendedContextFreeGrammar phi t r rr ->
  GExtendedContextFreeGrammar phi t r rr
combineEpsilonsE gram idx = runCERule $ gram idx