TU.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Transform.Rules.SYB.TU
-- Copyright   :  (c) 2010 University of Minho
-- License     :  BSD3
--
-- Maintainer  :  hpacheco@di.uminho.pt
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Pointless Rewrite:
-- automatic transformation system for point-free programs
-- 
-- Specialization rules for type-unifying strategy combinators.
--
-----------------------------------------------------------------------------

module Transform.Rules.SYB.TU where

import Data.Type
import Data.Eval
import Transform.Rewriting hiding (gmapQ)
import Control.Monad

emptyQ_applyQ :: Rule
emptyQ_applyQ _ (APPLYQ _ EMPTYQ) = success "emptyQ-applyQ" ZERO
emptyQ_applyQ _ _ = mzero

union_applyQ :: Rule
union_applyQ (Fun _ r) (APPLYQ a (UNION (f::Pf (Q r)) g)) = success "union-applyQ" $ gmapQProd r $ (APPLYQ a f) `SPLIT` (APPLYQ a g)
union_applyQ _ _ = mzero

gmapQ_applyQ :: Rule
gmapQ_applyQ (Fun _ r) (APPLYQ a (GMAPQ f)) = success "gmapQ-applyQ" (gmapQ r a f)
gmapQ_applyQ _ _ = mzero

everything_applyQ :: Rule
everything_applyQ (Fun a r) (APPLYQ _ (EVERYTHING f)) = success "everything-applyQ" (everythingQ r a f)
everything_applyQ _ _ = mzero

mkQ_applyQ :: Rule
mkQ_applyQ _ (APPLYQ a (MKQ b f)) = success "mkQ-applyQ" (mkQ a b f)
mkQ_applyQ _ _ = mzero

extQ_applyQ :: Rule
extQ_applyQ _ (APPLYQ a (EXTQ f t g)) = success "extQ-applyQ" (extQ a f t g)
extQ_applyQ _ _ = mzero

gmapQ_everything :: Rule
gmapQ_everything _ (GMAPQ (EVERYTHING f)) = success "gmapQ-everything" (EVERYTHING f)
gmapQ_everything _ _ = mzero