{-# LANGUAGE FlexibleContexts     #-}

module ASTExamples where

import AST
import ASTUse

import Control.Monad

import Data.List ((\\), nub)

import Generics.MultiRec.Base
import Generics.MultiRec.Rewriting.Rewriting
import Generics.MultiRec.Rewriting.Rules
--import Generics.MultiRec.Rewriting.Strategies
--import Generics.MultiRec.Rewriting.AC

import Generics.MultiRec.HFunctor

-- | Example expression

example = Let (Seq ("x" := Mul (Const 6) (Const 9)) None)
              (Add (EVar "x") (EVar "y"))

instance Rewrite AST

-- | A rewrite rule for expressions.

inlineRule var expr = Let (var := expr) (EVar var) :~> expr

-- | An example expression that matches the rule.

example2 = Let ("x" := Mul (Const 6) (Const 9))
               (EVar "x")
               
example3 = Let ("x" := (Const 4))
               (Add (EVar "a") (Add (EVar "b") (Add (EVar "c") (EVar "d"))))

-- | Testing generic rewriting

-- Does not type in GHC 6.8.3
testRewriting1 = rewrite Expr (rule Expr inlineRule) example2
{-
-- | Testing generation of associative/commutative-equivalent terms
testAC1 = acTerms Expr ["Add", "Mul"] example

acrule1 x y z = Add x (Add y z) :~> Add (Add x y) z
acrule2 x y z = Add (Add x y) z :~> Add x (Add y z)

testAC :: (MonadPlus m) => AST ix -> ix -> m ix
testAC Expr = rewriteM (rule Expr acrule1)
testAC _    = const mzero

test :: Expr -> [Expr]
test x = nub (fix (once testAC Expr) x ++ fix (once testAC Expr) x)

fix :: (Eq a) => (a -> [a]) -> a -> [a]
fix f x = fix' [x] f [x] where
  fix' :: (Eq a) => [a] -> (a -> [a]) -> [a] -> [a]
  fix' a f x = let result = concat (map f x)
               in if result \\ a == []
                  then a
                  else fix' (nub (result ++ a)) f result
-}