TP.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Transform.Rules.SYB.TP
-- 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-preserving strategy combinators.
--
-----------------------------------------------------------------------------

module Transform.Rules.SYB.TP where

import Data.Type
import Data.Pf
import Data.Eval
import Transform.Rewriting hiding (gmapQ)
import Transform.Rules.PF.Combinators
import Control.Monad

nop_applyT :: Rule
nop_applyT _ (APPLY _ NOP) = success "nop-applyT" ID
nop_applyT _ _ = mzero

seq_applyT :: Rule
seq_applyT _ (APPLY t (SEQ f g)) = success "seq-applyT" (COMP t (APPLY t f) (APPLY t g))
seq_applyT _ _ = mzero

gmapT_applyT :: Rule
gmapT_applyT _ (APPLY Dynamic (ALL f)) = mzero
gmapT_applyT _ (APPLY a (ALL f)) = success "gmapT-applyT" (allT a f)
gmapT_applyT _ _ = mzero

everywhere_applyT :: Rule
everywhere_applyT _ (APPLY a (EVERYWHERE f)) = success "everywhere-applyT" (everywhereT a f)
everywhere_applyT _ (APPLY a (EVERYWHERE' f)) = success "everywhere-applyT" (everywhereT' a f)
everywhere_applyT _ _ = mzero

mkT_applyT :: Rule
mkT_applyT _ (APPLY Dynamic (MKT b f)) = mzero
mkT_applyT _ (APPLY a (MKT b f)) = success "mkT-applyT" (mkT a b f)
mkT_applyT _ _ = mzero

extT_applyT :: Rule
extT_applyT _ (APPLY Dynamic (EXTT f t g)) = mzero
extT_applyT _ (APPLY a (EXTT f t g)) = success "extT-applyT" (extT a f t g)
extT_applyT _ _ = mzero

dyn_applyT, dyn_applyT' :: Rule
dyn_applyT = comp dyn_applyT'
dyn_applyT' (Fun _ _) (COMP _ (APPLY Dynamic f) (MKDYN a)) = success "dyn-ApplyQ" $ COMP a (MKDYN a) $ APPLY a f
dyn_applyT' _ _ = mzero

tp :: Rule
tp = top nop_applyT ||| top seq_applyT
 ||| top gmapT_applyT ||| top everywhere_applyT
 ||| top mkT_applyT ||| top extT_applyT ||| top dyn_applyT