module MyRewrites where 

import Language.Haskell.TH

import Language.Haskell.ER.Syntax
import Language.Haskell.ER.HaskellRewrite
import Language.Haskell.ER.MiscRewrite
import Language.Haskell.ER.Utils
import Language.Haskell.ER.Frees
import Control.Monad.ST
import Data.STRef
import Debug.Trace
import GHC.Err
import GHC.ST

import MyList

import Definition.PreludeList
import Definition.ImpList
import Equation.ImpList
import ImpList
import Iterator
import Data.Maybe
import GHC.List
import qualified MyPreludeList
import qualified HughesList

-- the dictionary for this module
dictionary :: [ UniHaskellRewrite ]
dictionary = 
	   map HaskellRewriteExp
	   [ dotdotdot
	   , ww_runST_return
	   , ww_runST_return2
	   , lift_runST
	   , monadLaw1
	   , append_rule1
	   , append_rule1'
	   , append_rule2
	   , append_rule3
	   , append_rule4
	   , append_rule5
	   , etaExpand
	   ] 

--defn_foldr :: HaskellRewrite Exp
--defn_foldr = defn 'foldr Program.PreludeList.defns

--rule_foldr_3 :: HaskellRewrite Exp
--rule_foldr_3 = equationFor $(quote [| foldr f z (x:xs) |]) defn_foldr
	       		   
rule_foldr_1 :: HaskellRewrite Exp
rule_foldr_1 = equation "/Prelude/foldr f z (x:xs)"
   $(quote [| foldr f z (x:xs) |])
   $(quote [| f x (foldr f z xs) |])
   Nothing
rule_foldr_2 :: HaskellRewrite Exp
rule_foldr_2 = equation "/Prelude/foldr f z []"
   $(quote [| foldr f z [] |])
   $(quote [| z |])
   Nothing

-- various hacks
dotdotdot = equation "@/hacks/..."
   $(quote [| a |])
   (VarE (mkName "..."))
   Nothing	    		      

ww_runST_return = equation "@/hacks/runST . return"
   $(quote [| e |])
   $(quote [| \ xs -> runST (return (e xs)) |])
   Nothing	    		      

ww_runST_return2 = equation "@/hacks/runST . return (2)"
   $(quote [| e |])
   $(quote [| \ x y -> runST (return (e x y)) |])
   Nothing	    		      
    

lift_runST :: HaskellRewrite Exp
lift_runST = equation "/MyRewrites/equations/f (runST e) = runST do { v <- e ; f v }" 
   $(quote [| f (runST e) |])
   $(quote [| runST (do { v <- e ; return (f v) }) |])
    Nothing


monadLaw1 :: HaskellRewrite Exp
monadLaw1  = equation "/Monads/do { v <- e ; return v } = e"
	  	   $(quote [| do { v <- e
		   	         ; return v
				 } |])
		   $(quote [| e |])
             Nothing

------------------------------------------------------------------------------

working_reverse :: HaskellRewrite Code
working_reverse = equation "/Working/Reverse Example"
   $(quoteCode [d| reverse []     = []
   	       	   reverse (x:xs) = reverse xs ++ [x] 
		|])
   $(quoteCode 
	       [d| reverse []     = []
   	       	   reverse (x:xs) = reverse xs ++ [x] 
		|])
     Nothing


append_rule1 :: HaskellRewrite Exp
append_rule1 = equation "/Program/Prelude/xs ++ [] = xs"
   $(quote [| xs ++ []
		|])
   $(quote [| xs
		|])
     Nothing

append_rule1' :: HaskellRewrite Exp
append_rule1' = equation "@/Eureka/Prelude/xs = xs ++ []"
   $(quote [| xs
		|])
   $(quote [| xs ++ []
		|])
     Nothing

append_rule2 :: HaskellRewrite Exp
append_rule2 = equation "/Program/Prelude/[] ++ xs = xs"
   $(quote [| [] ++ xs
		|])
   $(quote [| xs
		|])
     Nothing

append_rule3 :: HaskellRewrite Exp
append_rule3 = equation "/Program/Prelude/(x:xs) ++ ys = x : (xs ++ ys)"
   $(quote [| (x:xs) ++ ys
		|])
   $(quote [| x : (xs ++ ys)
		|])
     Nothing

append_rule5 :: HaskellRewrite Exp
append_rule5 = equation "/Program/Prelude/[x] ++ xs = x : xs"
   $(quote [| [x] ++ xs
		|])
   $(quote [| x : xs
		|])
     Nothing


append_rule4 :: HaskellRewrite Exp
append_rule4 = equation "/Program/Prelude/Assoc ++"
   $(quote [| (xs ++ ys) ++ zs
		|])
   $(quote [| xs ++ (ys ++ zs)
		|])
     Nothing

etaExpand :: HaskellRewrite Exp
etaExpand = equation "@/Eureka/bind/eta Expand"
	    $(quote [| e |])
	    $(quote [| \ v -> e v |])
	 Nothing