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.Pf
import Data.Eval
import Transform.Rewriting hiding (gmapQ)
import Transform.Rules.PF.Combinators
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" $ COMP (Prod r r) PLUS $ (APPLYQ a f) `SPLIT` (APPLYQ a g)
union_applyQ _ _ = mzero

gmapQ_applyQ :: Rule
gmapQ_applyQ (Fun _ r) (APPLYQ Dynamic (GMAPQ f)) = mzero
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 Dynamic (MKQ b f)) = mzero
mkQ_applyQ _ (APPLYQ a (MKQ b f)) = success "mkQ-applyQ" (mkQ a b f)
mkQ_applyQ _ _ = mzero

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

tu :: Rule
tu = top emptyQ_applyQ ||| top union_applyQ
 ||| top gmapQ_applyQ ||| top everything_applyQ
 ||| top mkQ_applyQ ||| top extQ_applyQ