module Examples.Expr where

import Data.Generics.Play
import Control.Monad.State


data Expr = Val Int
          | Add Expr Expr
          | Sub Expr Expr
          | Div Expr Expr
          | Mul Expr Expr
          | Neg Expr
          deriving (Show,Eq)


expr1 = Add (Val 1) (Add (Val 2) (Val 3))


instance Play Expr where
    replaceChildren x =
        case x of
            Add x y -> playTwo Add x y
            Sub x y -> playTwo Sub x y
            Div x y -> playTwo Div x y
            Mul x y -> playTwo Mul x y
            Neg x   -> playOne Neg x
            x -> playDefault x


eval :: Expr -> Int
eval = fold id $ \op args ->
    case (op,args) of
        (Val n, []) -> n
        (Neg x, [i]) -> negate i
        (_, [a,b]) ->
            (case op of
                Add{} -> (+)
                Sub{} -> (-)
                Div{} -> div
                Mul{} -> (*)
            ) a b


hasDivZero :: Expr -> Bool
hasDivZero x = not $ null [() | Div _ (Val 0) <- everything x]


depth :: Expr -> Int
depth = fold (foldr max 0) $ const (+1)


optimise :: Expr -> Expr
optimise = traverse $ \x -> case x of
    Neg (Val i) -> Val (negate i)
    Add x y | x == y -> Mul x (Val 2)
    x -> x


noNegate :: Expr -> Expr
noNegate x = case x of
    Neg (Val i) -> Val (negate i)
    Neg (Neg x) -> noNegate x
    Neg (Sub a b) -> Sub (noNegate b) (noNegate a)
    Neg (Add a b) -> Add (noNegate $ Neg a) (noNegate $ Neg b)
    Neg (Div a b) -> Div (noNegate $ Neg a) (noNegate b)
    Neg (Mul a b) -> Mul (noNegate $ Neg a) (noNegate b)
    x -> descend noNegate x


uniqueLits :: Expr -> Expr
uniqueLits x = evalState (traverseM f x) [0..]
    where
        f (Val i) = do
            y:ys <- get
            put ys
            return (Val y)
        f x = return x



reverseExpr :: Expr -> Expr
reverseExpr = traverse f
    where
        f x = generate $ reverse collect
            where (collect,generate) = replaceChildren x


mutate :: Expr -> [Expr]
mutate x = concat [[gen $ Val $ i-1, gen $ Val $ i+1] | (Val i, gen) <- everythingContext x]