{-# LANGUAGE ExistentialQuantification, PatternGuards, Rank2Types #-}

-- | This marvellous module contributed by Thomas J\344ger
module Lambdabot.Plugin.Haskell.Pl.Rules (RewriteRule(..), fire, rules) where

import Lambdabot.Plugin.Haskell.Pl.Common
import Lambdabot.Plugin.Haskell.Pl.RuleLib
import Lambdabot.Plugin.Haskell.Pl.Names


----------------------------------------------------------------------------------------
-- Operator rules

collapseLists :: Expr -> Maybe Expr
collapseLists :: Expr -> Maybe Expr
collapseLists (Var Fixity
_ String
"++" `App` Expr
e1 `App` Expr
e2)
  | ([Expr]
xs,Expr
x) <- Expr -> ([Expr], Expr)
getList Expr
e1, Expr
xforall a. Eq a => a -> a -> Bool
==Expr
nil,
    ([Expr]
ys,Expr
y) <- Expr -> ([Expr], Expr)
getList Expr
e2, Expr
yforall a. Eq a => a -> a -> Bool
==Expr
nil = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
makeList forall a b. (a -> b) -> a -> b
$ [Expr]
xs forall a. [a] -> [a] -> [a]
++ [Expr]
ys
collapseLists Expr
_ = forall a. Maybe a
Nothing

data Binary = forall a b c. (Read a, Show a, Read b, Show b, Read c, Show c) => BA (a -> b -> c)

evalBinary :: [(String, Binary)] -> Expr -> Maybe Expr
evalBinary :: [(String, Binary)] -> Expr -> Maybe Expr
evalBinary [(String, Binary)]
fs (Var Fixity
_ String
f' `App` Var Fixity
_ String
x' `App` Var Fixity
_ String
y')
  | Just (BA a -> b -> c
f) <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
f' [(String, Binary)]
fs = (Fixity -> String -> Expr
Var Fixity
Pref forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> b -> c
f (forall a (m :: * -> *). (Read a, Alternative m) => String -> m a
readM String
x') (forall a (m :: * -> *). (Read a, Alternative m) => String -> m a
readM String
y')
evalBinary [(String, Binary)]
_ Expr
_ = forall a. Maybe a
Nothing

data Unary = forall a b. (Read a, Show a, Read b, Show b) => UA (a -> b)

evalUnary :: [(String, Unary)] -> Expr -> Maybe Expr
evalUnary :: [(String, Unary)] -> Expr -> Maybe Expr
evalUnary [(String, Unary)]
fs (Var Fixity
_ String
f' `App` Var Fixity
_ String
x')
  | Just (UA a -> b
f) <- forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
f' [(String, Unary)]
fs = (Fixity -> String -> Expr
Var Fixity
Pref forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` forall a (m :: * -> *). (Read a, Alternative m) => String -> m a
readM String
x'
evalUnary [(String, Unary)]
_ Expr
_ = forall a. Maybe a
Nothing

assocR, assocL, assoc :: [String] -> Expr -> Maybe Expr
-- (f `op` g) `op` h --> f `op` (g `op` h)
assocR :: [String] -> Expr -> Maybe Expr
assocR [String]
ops (Var Fixity
f1 String
op1 `App` (Var Fixity
f2 String
op2 `App` Expr
e1 `App` Expr
e2) `App` Expr
e3)
  | String
op1 forall a. Eq a => a -> a -> Bool
== String
op2 Bool -> Bool -> Bool
&& String
op1 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ops
  = forall a. a -> Maybe a
Just (Fixity -> String -> Expr
Var Fixity
f1 String
op1 Expr -> Expr -> Expr
`App` Expr
e1 Expr -> Expr -> Expr
`App` (Fixity -> String -> Expr
Var Fixity
f2 String
op2 Expr -> Expr -> Expr
`App` Expr
e2 Expr -> Expr -> Expr
`App` Expr
e3))
assocR [String]
_ Expr
_ = forall a. Maybe a
Nothing

-- f `op` (g `op` h) --> (f `op` g) `op` h
assocL :: [String] -> Expr -> Maybe Expr
assocL [String]
ops (Var Fixity
f1 String
op1 `App` Expr
e1 `App` (Var Fixity
f2 String
op2 `App` Expr
e2 `App` Expr
e3))
  | String
op1 forall a. Eq a => a -> a -> Bool
== String
op2 Bool -> Bool -> Bool
&& String
op1 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ops
  = forall a. a -> Maybe a
Just (Fixity -> String -> Expr
Var Fixity
f1 String
op1 Expr -> Expr -> Expr
`App` (Fixity -> String -> Expr
Var Fixity
f2 String
op2 Expr -> Expr -> Expr
`App` Expr
e1 Expr -> Expr -> Expr
`App` Expr
e2) Expr -> Expr -> Expr
`App` Expr
e3)
assocL [String]
_ Expr
_ = forall a. Maybe a
Nothing

-- op f . op g --> op (f `op` g)
assoc :: [String] -> Expr -> Maybe Expr
assoc [String]
ops (Var Fixity
_ String
"." `App` (Var Fixity
f1 String
op1 `App` Expr
e1) `App` (Var Fixity
f2 String
op2 `App` Expr
e2))
  | String
op1 forall a. Eq a => a -> a -> Bool
== String
op2 Bool -> Bool -> Bool
&& String
op1 forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ops
  = forall a. a -> Maybe a
Just (Fixity -> String -> Expr
Var Fixity
f1 String
op1 Expr -> Expr -> Expr
`App` (Fixity -> String -> Expr
Var Fixity
f2 String
op2 Expr -> Expr -> Expr
`App` Expr
e1 Expr -> Expr -> Expr
`App` Expr
e2))
assoc [String]
_ Expr
_ = forall a. Maybe a
Nothing

commutative :: [String] -> Expr -> Maybe Expr
commutative :: [String] -> Expr -> Maybe Expr
commutative [String]
ops (Var Fixity
f String
op `App` Expr
e1 `App` Expr
e2)
  | String
op forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ops = forall a. a -> Maybe a
Just (Fixity -> String -> Expr
Var Fixity
f String
op Expr -> Expr -> Expr
`App` Expr
e2 Expr -> Expr -> Expr
`App` Expr
e1)
commutative [String]
ops (Var Fixity
_ String
"flip" `App` e :: Expr
e@(Var Fixity
_ String
op)) | String
op forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ops = forall a. a -> Maybe a
Just Expr
e
commutative [String]
_ Expr
_ = forall a. Maybe a
Nothing

----------------------------------------------------------------------------------------
-- Rewrite rules


-- TODO: Move rules into a file.
{-# INLINE simplifies #-}
simplifies :: RewriteRule
simplifies :: RewriteRule
simplifies = [RewriteRule] -> RewriteRule
Or [
  -- (f . g) x --> f (g x)
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
f MExpr
g MExpr
x -> (MExpr
f MExpr -> MExpr -> MExpr
`c` MExpr
g) MExpr -> MExpr -> MExpr
`a` MExpr
x)
      (\MExpr
f MExpr
g MExpr
x -> MExpr
f MExpr -> MExpr -> MExpr
`a` (MExpr
g MExpr -> MExpr -> MExpr
`a` MExpr
x)),
  -- id x --> x
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
x -> MExpr
idE MExpr -> MExpr -> MExpr
`a` MExpr
x)
      (\MExpr
x -> MExpr
x),
  -- flip (flip x) --> x
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
x -> MExpr
flipE MExpr -> MExpr -> MExpr
`a` (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
x))
      (\MExpr
x -> MExpr
x),
  -- flip id x . f --> flip f x
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
f MExpr
x -> (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
idE MExpr -> MExpr -> MExpr
`a` MExpr
x) MExpr -> MExpr -> MExpr
`c` MExpr
f)
      (\MExpr
f MExpr
x -> MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x),
  -- id . f --> f
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
f -> MExpr
idE MExpr -> MExpr -> MExpr
`c` MExpr
f)
      (\MExpr
f -> MExpr
f),
  -- f . id --> f
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
f -> MExpr
f MExpr -> MExpr -> MExpr
`c` MExpr
idE)
      (\MExpr
f -> MExpr
f),
  -- const x y --> x
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
x MExpr
y -> MExpr
constE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
y)
      (\MExpr
x MExpr
_ -> MExpr
x),
  -- not (not x) --> x
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
x -> MExpr
notE MExpr -> MExpr -> MExpr
`a` (MExpr
notE MExpr -> MExpr -> MExpr
`a` MExpr
x))
      (\MExpr
x -> MExpr
x),
  -- fst (x,y) --> x
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
x MExpr
y -> MExpr
fstE MExpr -> MExpr -> MExpr
`a` (MExpr
commaE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
y))
      (\MExpr
x MExpr
_ -> MExpr
x),
  -- snd (x,y) --> y
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
x MExpr
y -> MExpr
sndE MExpr -> MExpr -> MExpr
`a` (MExpr
commaE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
y))
      (\MExpr
_ MExpr
y -> MExpr
y),
  -- head (x:xs) --> x
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
x MExpr
xs -> MExpr
headE MExpr -> MExpr -> MExpr
`a` (MExpr
consE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
xs))
      (\MExpr
x MExpr
_  -> MExpr
x),
  -- tail (x:xs) --> xs
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
x MExpr
xs -> MExpr
tailE MExpr -> MExpr -> MExpr
`a` (MExpr
consE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
xs))
      (\MExpr
_ MExpr
xs -> MExpr
xs),
  -- uncurry f (x,y) --> f x y
  forall a. RewriteC a => a -> a -> RewriteRule
rr1 (\MExpr
f MExpr
x MExpr
y -> MExpr
uncurryE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` (MExpr
commaE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
y))
      (\MExpr
f MExpr
x MExpr
y -> MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
y),
  -- uncurry (,) --> id
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (MExpr
uncurryE MExpr -> MExpr -> MExpr
`a` MExpr
commaE)
      (MExpr
idE),
  -- uncurry f . s (,) g --> s f g
  forall a. RewriteC a => a -> a -> RewriteRule
rr1 (\MExpr
f MExpr
g -> (MExpr
uncurryE MExpr -> MExpr -> MExpr
`a` MExpr
f) MExpr -> MExpr -> MExpr
`c` (MExpr
sE MExpr -> MExpr -> MExpr
`a` MExpr
commaE MExpr -> MExpr -> MExpr
`a` MExpr
g))
      (\MExpr
f MExpr
g -> MExpr
sE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
g),
  -- curry fst --> const
  forall a. RewriteC a => a -> a -> RewriteRule
rr (MExpr
curryE MExpr -> MExpr -> MExpr
`a` MExpr
fstE) (MExpr
constE),
  -- curry snd --> const id
  forall a. RewriteC a => a -> a -> RewriteRule
rr (MExpr
curryE MExpr -> MExpr -> MExpr
`a` MExpr
sndE) (MExpr
constE MExpr -> MExpr -> MExpr
`a` MExpr
idE),
  -- s f g x --> f x (g x)
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
f MExpr
g MExpr
x -> MExpr
sE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
g MExpr -> MExpr -> MExpr
`a` MExpr
x)
      (\MExpr
f MExpr
g MExpr
x -> MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` (MExpr
g MExpr -> MExpr -> MExpr
`a` MExpr
x)),
  -- flip f x y --> f y x
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
f MExpr
x MExpr
y -> MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
y)
      (\MExpr
f MExpr
x MExpr
y -> MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
y MExpr -> MExpr -> MExpr
`a` MExpr
x),
  -- flip (=<<) --> (>>=)
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
extE)
      MExpr
bindE,

  -- TODO: Think about map/fmap
  -- fmap id --> id
  forall a. RewriteC a => a -> a -> RewriteRule
rr (MExpr
fmapE MExpr -> MExpr -> MExpr
`a` MExpr
idE)
     (MExpr
idE),
  -- map id --> id
  forall a. RewriteC a => a -> a -> RewriteRule
rr (MExpr
mapE MExpr -> MExpr -> MExpr
`a` MExpr
idE)
     (MExpr
idE),
  -- (f . g) . h --> f . (g . h)
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
f MExpr
g MExpr
h -> (MExpr
f MExpr -> MExpr -> MExpr
`c` MExpr
g) MExpr -> MExpr -> MExpr
`c` MExpr
h)
      (\MExpr
f MExpr
g MExpr
h -> MExpr
f MExpr -> MExpr -> MExpr
`c` (MExpr
g MExpr -> MExpr -> MExpr
`c` MExpr
h)),
  -- fmap f . fmap g -> fmap (f . g)
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
f MExpr
g -> MExpr
fmapE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`c` MExpr
fmapE MExpr -> MExpr -> MExpr
`a` MExpr
g)
      (\MExpr
f MExpr
g -> MExpr
fmapE MExpr -> MExpr -> MExpr
`a` (MExpr
f MExpr -> MExpr -> MExpr
`c` MExpr
g)),
  -- map f . map g -> map (f . g)
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
f MExpr
g -> MExpr
mapE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`c` MExpr
mapE MExpr -> MExpr -> MExpr
`a` MExpr
g)
      (\MExpr
f MExpr
g -> MExpr
mapE MExpr -> MExpr -> MExpr
`a` (MExpr
f MExpr -> MExpr -> MExpr
`c` MExpr
g))

  ]

onceRewrites :: RewriteRule
onceRewrites :: RewriteRule
onceRewrites = RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$ [RewriteRule] -> RewriteRule
Or [
  -- ($) --> id
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (MExpr
dollarE)
      MExpr
idE,
  -- concatMap --> (=<<)
  forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
concatMapE MExpr
extE,
  -- concat    --> join
  forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
concatE MExpr
joinE,
  -- liftM --> fmap
  forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
liftME MExpr
fmapE,
  -- map --> fmap
  forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
mapE MExpr
fmapE,
  -- subtract -> flip (-)
  forall a. RewriteC a => a -> a -> RewriteRule
rr  MExpr
subtractE
      (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
minusE)
  ]

-- Now we can state rewrite rules in a nice high level way
-- Rewrite rules should be as pointful as possible since the pointless variants
-- will be derived automatically.
rules :: RewriteRule
rules :: RewriteRule
rules = [RewriteRule] -> RewriteRule
Or [
  -- f (g x) --> (f . g) x
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
f MExpr
g MExpr
x -> MExpr
f MExpr -> MExpr -> MExpr
`a` (MExpr
g MExpr -> MExpr -> MExpr
`a` MExpr
x))
      (\MExpr
f MExpr
g MExpr
x -> (MExpr
f MExpr -> MExpr -> MExpr
`c` MExpr
g) MExpr -> MExpr -> MExpr
`a` MExpr
x),
  -- (>>=) --> flip (=<<)
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$
  forall a. RewriteC a => a -> a -> RewriteRule
rr  MExpr
bindE
      (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
extE),
  -- (.) id --> id
  forall a. RewriteC a => a -> a -> RewriteRule
rr (MExpr
compE MExpr -> MExpr -> MExpr
`a` MExpr
idE)
     MExpr
idE,
  -- (++) [x] --> (:) x
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
x -> MExpr
appendE MExpr -> MExpr -> MExpr
`a` (MExpr
consE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
nilE))
      (\MExpr
x -> MExpr
consE MExpr -> MExpr -> MExpr
`a` MExpr
x),
  -- (=<<) return --> id
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (MExpr
extE MExpr -> MExpr -> MExpr
`a` MExpr
returnE)
      MExpr
idE,
  -- (=<<) f (return x) -> f x
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
f MExpr
x -> MExpr
extE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` (MExpr
returnE MExpr -> MExpr -> MExpr
`a` MExpr
x))
      (\MExpr
f MExpr
x -> MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x),
  -- (=<<) ((=<<) f . g) --> (=<<) f . (=<<) g
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
f MExpr
g -> MExpr
extE MExpr -> MExpr -> MExpr
`a` ((MExpr
extE MExpr -> MExpr -> MExpr
`a` MExpr
f) MExpr -> MExpr -> MExpr
`c` MExpr
g))
      (\MExpr
f MExpr
g -> (MExpr
extE MExpr -> MExpr -> MExpr
`a` MExpr
f) MExpr -> MExpr -> MExpr
`c` (MExpr
extE MExpr -> MExpr -> MExpr
`a` MExpr
g)),
  -- flip (f . g) --> flip (.) g . flip f
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
f MExpr
g -> MExpr
flipE MExpr -> MExpr -> MExpr
`a` (MExpr
f MExpr -> MExpr -> MExpr
`c` MExpr
g))
      (\MExpr
f MExpr
g -> (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
compE MExpr -> MExpr -> MExpr
`a` MExpr
g) MExpr -> MExpr -> MExpr
`c` (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
f)),
  -- flip (.) f . flip id --> flip f
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
f -> (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
compE MExpr -> MExpr -> MExpr
`a` MExpr
f) MExpr -> MExpr -> MExpr
`c` (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
idE))
      (\MExpr
f -> MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
f),
  -- flip (.) f . flip flip --> flip (flip . f)
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
f -> (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
compE MExpr -> MExpr -> MExpr
`a` MExpr
f) MExpr -> MExpr -> MExpr
`c` (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
flipE))
      (\MExpr
f -> MExpr
flipE MExpr -> MExpr -> MExpr
`a` (MExpr
flipE MExpr -> MExpr -> MExpr
`c` MExpr
f)),
  -- flip (flip (flip . f) g) --> flip (flip . flip f) g
  forall a. RewriteC a => a -> a -> RewriteRule
rr1 (\MExpr
f MExpr
g -> MExpr
flipE MExpr -> MExpr -> MExpr
`a` (MExpr
flipE MExpr -> MExpr -> MExpr
`a` (MExpr
flipE MExpr -> MExpr -> MExpr
`c` MExpr
f) MExpr -> MExpr -> MExpr
`a` MExpr
g))
      (\MExpr
f MExpr
g -> MExpr
flipE MExpr -> MExpr -> MExpr
`a` (MExpr
flipE MExpr -> MExpr -> MExpr
`c` MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
f) MExpr -> MExpr -> MExpr
`a` MExpr
g),

  -- flip (.) id --> id
  forall a. RewriteC a => a -> a -> RewriteRule
rr (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
compE MExpr -> MExpr -> MExpr
`a` MExpr
idE)
     MExpr
idE,
  -- (.) . flip id --> flip flip
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (MExpr
compE MExpr -> MExpr -> MExpr
`c` (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
idE))
      (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
flipE),
  -- s const x y --> y
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
x MExpr
y -> MExpr
sE MExpr -> MExpr -> MExpr
`a` MExpr
constE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
y)
      (\MExpr
_ MExpr
y -> MExpr
y),
  -- s (const . f) g --> f
  forall a. RewriteC a => a -> a -> RewriteRule
rr1 (\MExpr
f MExpr
g -> MExpr
sE MExpr -> MExpr -> MExpr
`a` (MExpr
constE MExpr -> MExpr -> MExpr
`c` MExpr
f) MExpr -> MExpr -> MExpr
`a` MExpr
g)
      (\MExpr
f MExpr
_ -> MExpr
f),
  -- s (const f) --> (.) f
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
f -> MExpr
sE MExpr -> MExpr -> MExpr
`a` (MExpr
constE MExpr -> MExpr -> MExpr
`a` MExpr
f))
      (\MExpr
f -> MExpr
compE MExpr -> MExpr -> MExpr
`a` MExpr
f),
  -- (`ap` f) . const . h --> (. f) . h
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
f MExpr
g MExpr
h -> (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
sE MExpr -> MExpr -> MExpr
`a` MExpr
f) MExpr -> MExpr -> MExpr
`c` (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
compE MExpr -> MExpr -> MExpr
`a` MExpr
g) MExpr -> MExpr -> MExpr
`c` MExpr
constE MExpr -> MExpr -> MExpr
`c` MExpr
h)
      (\MExpr
f MExpr
_ MExpr
h -> (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
compE MExpr -> MExpr -> MExpr
`a` MExpr
f) MExpr -> MExpr -> MExpr
`c` MExpr
h),
  -- s (f . fst) snd --> uncurry f
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
f -> MExpr
sE MExpr -> MExpr -> MExpr
`a` (MExpr
f MExpr -> MExpr -> MExpr
`c` MExpr
fstE) MExpr -> MExpr -> MExpr
`a` MExpr
sndE)
      (\MExpr
f -> MExpr
uncurryE MExpr -> MExpr -> MExpr
`a` MExpr
f),
  -- fst (join (,) x) --> x
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
x -> MExpr
fstE MExpr -> MExpr -> MExpr
`a` (MExpr
joinE MExpr -> MExpr -> MExpr
`a` MExpr
commaE MExpr -> MExpr -> MExpr
`a` MExpr
x))
     (\MExpr
x -> MExpr
x),
  -- snd (join (,) x) --> x
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
x -> MExpr
sndE MExpr -> MExpr -> MExpr
`a` (MExpr
joinE MExpr -> MExpr -> MExpr
`a` MExpr
commaE MExpr -> MExpr -> MExpr
`a` MExpr
x))
     (\MExpr
x -> MExpr
x),
  -- The next two are `simplifies', strictly speaking, but invoked rarely.
  -- uncurry f (x,y) --> f x y
--  rr  (\f x y -> uncurryE `a` f `a` (commaE `a` x `a` y))
--      (\f x y -> f `a` x `a` y),
  -- curry (uncurry f) --> f
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f -> MExpr
curryE MExpr -> MExpr -> MExpr
`a` (MExpr
uncurryE MExpr -> MExpr -> MExpr
`a` MExpr
f))
     (\MExpr
f -> MExpr
f),
  -- uncurry (curry f) --> f
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f -> MExpr
uncurryE MExpr -> MExpr -> MExpr
`a` (MExpr
curryE MExpr -> MExpr -> MExpr
`a` MExpr
f))
     (\MExpr
f -> MExpr
f),
  -- (const id . f) --> const id
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
f -> (MExpr
constE MExpr -> MExpr -> MExpr
`a` MExpr
idE) MExpr -> MExpr -> MExpr
`c` MExpr
f)
      (\MExpr
_ -> MExpr
constE MExpr -> MExpr -> MExpr
`a` MExpr
idE),
  -- const x . f --> const x
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
x MExpr
f -> MExpr
constE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`c` MExpr
f)
     (\MExpr
x MExpr
_ -> MExpr
constE MExpr -> MExpr -> MExpr
`a` MExpr
x),
  -- (. f) . const --> const
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f -> (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
compE MExpr -> MExpr -> MExpr
`a` MExpr
f) MExpr -> MExpr -> MExpr
`c` MExpr
constE)
     (\MExpr
_ -> MExpr
constE),
  -- (. f) . const . g --> const . g
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
g -> (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
compE MExpr -> MExpr -> MExpr
`a` MExpr
f) MExpr -> MExpr -> MExpr
`c` MExpr
constE MExpr -> MExpr -> MExpr
`c` MExpr
g)
     (\MExpr
_ MExpr
g -> MExpr
constE MExpr -> MExpr -> MExpr
`c` MExpr
g),
  -- fix f --> f (fix x)
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
f -> MExpr
fixE MExpr -> MExpr -> MExpr
`a` MExpr
f)
      (\MExpr
f -> MExpr
f MExpr -> MExpr -> MExpr
`a` (MExpr
fixE MExpr -> MExpr -> MExpr
`a` MExpr
f)),
  -- f (fix f) --> fix x
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
f -> MExpr
f MExpr -> MExpr -> MExpr
`a` (MExpr
fixE MExpr -> MExpr -> MExpr
`a` MExpr
f))
      (\MExpr
f -> MExpr
fixE MExpr -> MExpr -> MExpr
`a` MExpr
f),
  -- fix f --> f (f (fix x))
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
f -> MExpr
fixE MExpr -> MExpr -> MExpr
`a` MExpr
f)
      (\MExpr
f -> MExpr
f MExpr -> MExpr -> MExpr
`a` (MExpr
f MExpr -> MExpr -> MExpr
`a` (MExpr
fixE MExpr -> MExpr -> MExpr
`a` MExpr
f))),
  -- fix (const f) --> f
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f -> MExpr
fixE MExpr -> MExpr -> MExpr
`a` (MExpr
constE MExpr -> MExpr -> MExpr
`a` MExpr
f))
     (\MExpr
f -> MExpr
f),
  -- flip const x --> id
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
x -> MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
constE MExpr -> MExpr -> MExpr
`a` MExpr
x)
      (\MExpr
_ -> MExpr
idE),
  -- const . f --> flip (const f)
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
f -> MExpr
constE MExpr -> MExpr -> MExpr
`c` MExpr
f)
      (\MExpr
f -> MExpr
flipE MExpr -> MExpr -> MExpr
`a` (MExpr
constE MExpr -> MExpr -> MExpr
`a` MExpr
f)),
  -- not (x == y) -> x /= y
  forall a. RewriteC a => a -> a -> RewriteRule
rr2 (\MExpr
x MExpr
y -> MExpr
notE MExpr -> MExpr -> MExpr
`a` (MExpr
equalsE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
y))
      (\MExpr
x MExpr
y -> MExpr
nequalsE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
y),
  -- not (x /= y) -> x == y
  forall a. RewriteC a => a -> a -> RewriteRule
rr2 (\MExpr
x MExpr
y -> MExpr
notE MExpr -> MExpr -> MExpr
`a` (MExpr
nequalsE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
y))
      (\MExpr
x MExpr
y -> MExpr
equalsE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
y),
  RewriteRule -> RewriteRule -> RewriteRule
If ([RewriteRule] -> RewriteRule
Or [forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
plusE MExpr
plusE, forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
minusE MExpr
minusE, forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
multE MExpr
multE]) forall a b. (a -> b) -> a -> b
$ RewriteRule -> RewriteRule
down forall a b. (a -> b) -> a -> b
$ [RewriteRule] -> RewriteRule
Or [
    -- 0 + x --> x
    forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
x -> MExpr
plusE MExpr -> MExpr -> MExpr
`a` MExpr
zeroE MExpr -> MExpr -> MExpr
`a` MExpr
x)
        (\MExpr
x -> MExpr
x),
    -- 0 * x --> 0
    forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
x -> MExpr
multE MExpr -> MExpr -> MExpr
`a` MExpr
zeroE MExpr -> MExpr -> MExpr
`a` MExpr
x)
        (\MExpr
_ -> MExpr
zeroE),
    -- 1 * x --> x
    forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
x -> MExpr
multE MExpr -> MExpr -> MExpr
`a` MExpr
oneE MExpr -> MExpr -> MExpr
`a` MExpr
x)
        (\MExpr
x -> MExpr
x),
    -- x - x --> 0
    forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
x -> MExpr
minusE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
x)
        (\MExpr
_ -> MExpr
zeroE),
    -- x - y + y --> x
    forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
y MExpr
x -> MExpr
plusE MExpr -> MExpr -> MExpr
`a` (MExpr
minusE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
y) MExpr -> MExpr -> MExpr
`a` MExpr
y)
        (\MExpr
_ MExpr
x -> MExpr
x),
    -- x + y - y --> x
    forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
y MExpr
x -> MExpr
minusE MExpr -> MExpr -> MExpr
`a` (MExpr
plusE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
y) MExpr -> MExpr -> MExpr
`a` MExpr
y)
        (\MExpr
_ MExpr
x -> MExpr
x),
    -- x + (y - z) --> x + y - z
    forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
x MExpr
y MExpr
z -> MExpr
plusE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` (MExpr
minusE MExpr -> MExpr -> MExpr
`a` MExpr
y MExpr -> MExpr -> MExpr
`a` MExpr
z))
        (\MExpr
x MExpr
y MExpr
z -> MExpr
minusE MExpr -> MExpr -> MExpr
`a` (MExpr
plusE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
y) MExpr -> MExpr -> MExpr
`a` MExpr
z),
    -- x - (y + z) --> x - y - z
    forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
x MExpr
y MExpr
z -> MExpr
minusE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` (MExpr
plusE MExpr -> MExpr -> MExpr
`a` MExpr
y MExpr -> MExpr -> MExpr
`a` MExpr
z))
        (\MExpr
x MExpr
y MExpr
z -> MExpr
minusE MExpr -> MExpr -> MExpr
`a` (MExpr
minusE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
y) MExpr -> MExpr -> MExpr
`a` MExpr
z),
    -- x - (y - z) --> x + y - z
    forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
x MExpr
y MExpr
z -> MExpr
minusE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` (MExpr
minusE MExpr -> MExpr -> MExpr
`a` MExpr
y MExpr -> MExpr -> MExpr
`a` MExpr
z))
        (\MExpr
x MExpr
y MExpr
z -> MExpr
minusE MExpr -> MExpr -> MExpr
`a` (MExpr
plusE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
y) MExpr -> MExpr -> MExpr
`a` MExpr
z)
  ],

  RewriteRule -> RewriteRule
Hard RewriteRule
onceRewrites,
  -- join (fmap f x) --> f =<< x
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
x -> MExpr
joinE MExpr -> MExpr -> MExpr
`a` (MExpr
fmapE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x))
     (\MExpr
f MExpr
x -> MExpr
extE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x),
  -- (=<<) id --> join
  forall a. RewriteC a => a -> a -> RewriteRule
rr (MExpr
extE MExpr -> MExpr -> MExpr
`a` MExpr
idE) MExpr
joinE,
  -- join --> (=<<) id
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$
  forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
joinE (MExpr
extE MExpr -> MExpr -> MExpr
`a` MExpr
idE),
  -- join (return x) --> x
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
x -> MExpr
joinE MExpr -> MExpr -> MExpr
`a` (MExpr
returnE MExpr -> MExpr -> MExpr
`a` MExpr
x))
     (\MExpr
x -> MExpr
x),
  -- (return . f) =<< m --> fmap f m
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
m -> MExpr
extE MExpr -> MExpr -> MExpr
`a` (MExpr
returnE MExpr -> MExpr -> MExpr
`c` MExpr
f) MExpr -> MExpr -> MExpr
`a` MExpr
m)
     (\MExpr
f MExpr
m -> MExpr
fmapIE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
m),
  -- (x >>=) . (return .) . f  --> flip (fmap . f) x
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
x -> MExpr
bindE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`c` (MExpr
compE MExpr -> MExpr -> MExpr
`a` MExpr
returnE) MExpr -> MExpr -> MExpr
`c` MExpr
f)
     (\MExpr
f MExpr
x -> MExpr
flipE MExpr -> MExpr -> MExpr
`a` (MExpr
fmapIE MExpr -> MExpr -> MExpr
`c` MExpr
f) MExpr -> MExpr -> MExpr
`a` MExpr
x),
  -- (>>=) (return f) --> flip id f
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f -> MExpr
bindE MExpr -> MExpr -> MExpr
`a` (MExpr
returnE MExpr -> MExpr -> MExpr
`a` MExpr
f))
     (\MExpr
f -> MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
idE MExpr -> MExpr -> MExpr
`a` MExpr
f),
  -- liftM2 f x --> ap (f `fmap` x)
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
x -> MExpr
liftM2E MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x)
     (\MExpr
f MExpr
x -> MExpr
apE MExpr -> MExpr -> MExpr
`a` (MExpr
fmapIE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x)),
  -- liftM2 f (return x) --> fmap (f x)
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
x -> MExpr
liftM2E MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` (MExpr
returnE MExpr -> MExpr -> MExpr
`a` MExpr
x))
     (\MExpr
f MExpr
x -> MExpr
fmapIE MExpr -> MExpr -> MExpr
`a` (MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x)),
  -- f `fmap` return x --> return (f x)
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
x -> MExpr
fmapE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` (MExpr
returnE MExpr -> MExpr -> MExpr
`a` MExpr
x))
     (\MExpr
f MExpr
x -> MExpr
returnE MExpr -> MExpr -> MExpr
`a` (MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x)),
  -- (=<<) . flip (fmap . f) --> flip liftM2 f
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f -> MExpr
extE MExpr -> MExpr -> MExpr
`c` MExpr
flipE MExpr -> MExpr -> MExpr
`a` (MExpr
fmapE MExpr -> MExpr -> MExpr
`c` MExpr
f))
     (\MExpr
f -> MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
liftM2E MExpr -> MExpr -> MExpr
`a` MExpr
f),

  -- (.) -> fmap
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$
  forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
compE MExpr
fmapE,

  -- map f (zip xs ys) --> zipWith (curry f) xs ys
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
xs MExpr
ys -> MExpr
mapE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` (MExpr
zipE MExpr -> MExpr -> MExpr
`a` MExpr
xs MExpr -> MExpr -> MExpr
`a` MExpr
ys))
     (\MExpr
f MExpr
xs MExpr
ys -> MExpr
zipWithE MExpr -> MExpr -> MExpr
`a` (MExpr
curryE MExpr -> MExpr -> MExpr
`a` MExpr
f) MExpr -> MExpr -> MExpr
`a` MExpr
xs MExpr -> MExpr -> MExpr
`a` MExpr
ys),
  -- zipWith (,) --> zip (,)
  forall a. RewriteC a => a -> a -> RewriteRule
rr (MExpr
zipWithE MExpr -> MExpr -> MExpr
`a` MExpr
commaE) MExpr
zipE,

  -- all f --> and . map f
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f -> MExpr
allE MExpr -> MExpr -> MExpr
`a` MExpr
f)
     (\MExpr
f -> MExpr
andE MExpr -> MExpr -> MExpr
`c` MExpr
mapE MExpr -> MExpr -> MExpr
`a` MExpr
f),
  -- and . map f --> all f
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f -> MExpr
andE MExpr -> MExpr -> MExpr
`c` MExpr
mapE MExpr -> MExpr -> MExpr
`a` MExpr
f)
     (\MExpr
f -> MExpr
allE MExpr -> MExpr -> MExpr
`a` MExpr
f),
  -- any f --> or . map f
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f -> MExpr
anyE MExpr -> MExpr -> MExpr
`a` MExpr
f)
     (\MExpr
f -> MExpr
orE MExpr -> MExpr -> MExpr
`c` MExpr
mapE MExpr -> MExpr -> MExpr
`a` MExpr
f),
  -- or . map f --> any f
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f -> MExpr
orE MExpr -> MExpr -> MExpr
`c` MExpr
mapE MExpr -> MExpr -> MExpr
`a` MExpr
f)
     (\MExpr
f -> MExpr
anyE MExpr -> MExpr -> MExpr
`a` MExpr
f),

  -- return f `ap` x --> fmap f x
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
x -> MExpr
apE MExpr -> MExpr -> MExpr
`a` (MExpr
returnE MExpr -> MExpr -> MExpr
`a` MExpr
f) MExpr -> MExpr -> MExpr
`a` MExpr
x)
     (\MExpr
f MExpr
x -> MExpr
fmapIE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x),
  -- ap (f `fmap` x) --> liftM2 f x
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
x -> MExpr
apE MExpr -> MExpr -> MExpr
`a` (MExpr
fmapIE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x))
     (\MExpr
f MExpr
x -> MExpr
liftM2E MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x),
  -- f `ap` x --> (`fmap` x) =<< f
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
x -> MExpr
apE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x)
     (\MExpr
f MExpr
x -> MExpr
extE MExpr -> MExpr -> MExpr
`a` (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
fmapIE MExpr -> MExpr -> MExpr
`a` MExpr
x) MExpr -> MExpr -> MExpr
`a` MExpr
f),
  -- (`fmap` x) =<< f --> f `ap` x
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
x -> MExpr
extE MExpr -> MExpr -> MExpr
`a` (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
fmapIE MExpr -> MExpr -> MExpr
`a` MExpr
x) MExpr -> MExpr -> MExpr
`a` MExpr
f)
     (\MExpr
f MExpr
x -> MExpr
apE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x),
  -- (x >>=) . flip (fmap . f) -> liftM2 f x
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
x -> MExpr
bindE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`c` MExpr
flipE MExpr -> MExpr -> MExpr
`a` (MExpr
fmapE MExpr -> MExpr -> MExpr
`c` MExpr
f))
     (\MExpr
f MExpr
x -> MExpr
liftM2E MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x),

  -- (f =<< m) x --> f (m x) x
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
f MExpr
m MExpr
x -> MExpr
extE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
m MExpr -> MExpr -> MExpr
`a` MExpr
x)
      (\MExpr
f MExpr
m MExpr
x -> MExpr
f MExpr -> MExpr -> MExpr
`a` (MExpr
m MExpr -> MExpr -> MExpr
`a` MExpr
x) MExpr -> MExpr -> MExpr
`a` MExpr
x),
  -- (fmap f g x) --> f (g x)
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
f MExpr
g MExpr
x -> MExpr
fmapE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
g MExpr -> MExpr -> MExpr
`a` MExpr
x)
      (\MExpr
f MExpr
g MExpr
x -> MExpr
f MExpr -> MExpr -> MExpr
`a` (MExpr
g MExpr -> MExpr -> MExpr
`a` MExpr
x)),
  -- return x y --> y
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
y MExpr
x -> MExpr
returnE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
y)
      (\MExpr
y MExpr
_ -> MExpr
y),
  -- liftM2 f g h x --> g x `h` h x
  forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
f MExpr
g MExpr
h MExpr
x -> MExpr
liftM2E MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
g MExpr -> MExpr -> MExpr
`a` MExpr
h MExpr -> MExpr -> MExpr
`a` MExpr
x)
      (\MExpr
f MExpr
g MExpr
h MExpr
x -> MExpr
f MExpr -> MExpr -> MExpr
`a` (MExpr
g MExpr -> MExpr -> MExpr
`a` MExpr
x) MExpr -> MExpr -> MExpr
`a` (MExpr
h MExpr -> MExpr -> MExpr
`a` MExpr
x)),
  -- ap f id --> join f
  forall a. RewriteC a => a -> a -> RewriteRule
rr  (\MExpr
f -> MExpr
apE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
idE)
      (\MExpr
f -> MExpr
joinE MExpr -> MExpr -> MExpr
`a` MExpr
f),

  -- (=<<) const q --> flip (>>) q
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$ -- ??
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
q MExpr
p -> MExpr
extE MExpr -> MExpr -> MExpr
`a` (MExpr
constE MExpr -> MExpr -> MExpr
`a` MExpr
q) MExpr -> MExpr -> MExpr
`a` MExpr
p)
     (\MExpr
q MExpr
p -> MExpr
seqME MExpr -> MExpr -> MExpr
`a` MExpr
p MExpr -> MExpr -> MExpr
`a` MExpr
q),
  -- p >> q --> const q =<< p
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
p MExpr
q -> MExpr
seqME MExpr -> MExpr -> MExpr
`a` MExpr
p MExpr -> MExpr -> MExpr
`a` MExpr
q)
     (\MExpr
p MExpr
q -> MExpr
extE MExpr -> MExpr -> MExpr
`a` (MExpr
constE MExpr -> MExpr -> MExpr
`a` MExpr
q) MExpr -> MExpr -> MExpr
`a` MExpr
p),

  -- experimental support for Control.Arrow stuff
  -- (costs quite a bit of performance)
  -- uncurry ((. g) . (,) . f) --> f *** g
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
g -> MExpr
uncurryE MExpr -> MExpr -> MExpr
`a` ((MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
compE MExpr -> MExpr -> MExpr
`a` MExpr
g) MExpr -> MExpr -> MExpr
`c` MExpr
commaE MExpr -> MExpr -> MExpr
`c` MExpr
f))
     (\MExpr
f MExpr
g -> MExpr
crossE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
g),
  -- uncurry ((,) . f) --> first f
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f -> MExpr
uncurryE MExpr -> MExpr -> MExpr
`a` (MExpr
commaE MExpr -> MExpr -> MExpr
`c` MExpr
f))
     (\MExpr
f -> MExpr
firstE MExpr -> MExpr -> MExpr
`a` MExpr
f),
  -- uncurry ((. g) . (,)) --> second g
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
g -> MExpr
uncurryE MExpr -> MExpr -> MExpr
`a` ((MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
compE MExpr -> MExpr -> MExpr
`a` MExpr
g) MExpr -> MExpr -> MExpr
`c` MExpr
commaE))
     (\MExpr
g -> MExpr
secondE MExpr -> MExpr -> MExpr
`a` MExpr
g),
  -- I think we need all three of them:
  -- uncurry (const f) --> f . snd
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f -> MExpr
uncurryE MExpr -> MExpr -> MExpr
`a` (MExpr
constE MExpr -> MExpr -> MExpr
`a` MExpr
f))
     (\MExpr
f -> MExpr
f MExpr -> MExpr -> MExpr
`c` MExpr
sndE),
  -- uncurry const --> fst
  forall a. RewriteC a => a -> a -> RewriteRule
rr (MExpr
uncurryE MExpr -> MExpr -> MExpr
`a` MExpr
constE)
     (MExpr
fstE),
  -- uncurry (const . f) --> f . fst
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f -> MExpr
uncurryE MExpr -> MExpr -> MExpr
`a` (MExpr
constE MExpr -> MExpr -> MExpr
`c` MExpr
f))
     (\MExpr
f -> MExpr
f MExpr -> MExpr -> MExpr
`c` MExpr
fstE),

  -- TODO is this the right place?
  -- [x] --> return x
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$
  forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
x -> MExpr
consE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
nilE)
     (\MExpr
x -> MExpr
returnE MExpr -> MExpr -> MExpr
`a` MExpr
x),
  -- list destructors
  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$
  RewriteRule -> RewriteRule -> RewriteRule
If ([RewriteRule] -> RewriteRule
Or [forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
consE MExpr
consE, forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
nilE MExpr
nilE]) forall a b. (a -> b) -> a -> b
$ [RewriteRule] -> RewriteRule
Or [
    RewriteRule -> RewriteRule
down forall a b. (a -> b) -> a -> b
$ [RewriteRule] -> RewriteRule
Or [
      -- length [] --> 0
      forall a. RewriteC a => a -> a -> RewriteRule
rr (MExpr
lengthE MExpr -> MExpr -> MExpr
`a` MExpr
nilE)
         MExpr
zeroE,
      -- length (x:xs) --> 1 + length xs
      forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
x MExpr
xs -> MExpr
lengthE MExpr -> MExpr -> MExpr
`a` (MExpr
consE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
xs))
         (\MExpr
_ MExpr
xs -> MExpr
plusE MExpr -> MExpr -> MExpr
`a` MExpr
oneE MExpr -> MExpr -> MExpr
`a` (MExpr
lengthE MExpr -> MExpr -> MExpr
`a` MExpr
xs))
    ],
    -- map/fmap elimination
    RewriteRule -> RewriteRule
down forall a b. (a -> b) -> a -> b
$ [RewriteRule] -> RewriteRule
Or [
      -- map f (x:xs) --> f x: map f xs
      forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
x MExpr
xs -> MExpr
mapE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` (MExpr
consE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
xs))
         (\MExpr
f MExpr
x MExpr
xs -> MExpr
consE MExpr -> MExpr -> MExpr
`a` (MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x) MExpr -> MExpr -> MExpr
`a` (MExpr
mapE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
xs)),
      -- fmap f (x:xs) --> f x: Fmap f xs
      forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
x MExpr
xs -> MExpr
fmapE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` (MExpr
consE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
xs))
         (\MExpr
f MExpr
x MExpr
xs -> MExpr
consE MExpr -> MExpr -> MExpr
`a` (MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x) MExpr -> MExpr -> MExpr
`a` (MExpr
fmapE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
xs)),
      -- map f []     --> []
      forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f -> MExpr
mapE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
nilE)
         (\MExpr
_ -> MExpr
nilE),
      -- fmap f []     --> []
      forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f -> MExpr
fmapE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
nilE)
         (\MExpr
_ -> MExpr
nilE)
    ],
    -- foldr elimination
    RewriteRule -> RewriteRule
down forall a b. (a -> b) -> a -> b
$ [RewriteRule] -> RewriteRule
Or [
      -- foldr f z (x:xs) --> f x (foldr f z xs)
      forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
x MExpr
xs MExpr
z -> (MExpr
foldrE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
z) MExpr -> MExpr -> MExpr
`a` (MExpr
consE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
xs))
         (\MExpr
f MExpr
x MExpr
xs MExpr
z -> (MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x) MExpr -> MExpr -> MExpr
`a` (MExpr
foldrE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
z MExpr -> MExpr -> MExpr
`a` MExpr
xs)),
      -- foldr f z [] --> z
      forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
z -> MExpr
foldrE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
z MExpr -> MExpr -> MExpr
`a` MExpr
nilE)
         (\MExpr
_ MExpr
z -> MExpr
z)
    ],
    -- foldl elimination
    RewriteRule -> RewriteRule
down forall a b. (a -> b) -> a -> b
$ RewriteRule -> RewriteRule
Opt ((Expr -> Maybe Expr) -> RewriteRule
CRR forall a b. (a -> b) -> a -> b
$ [String] -> Expr -> Maybe Expr
assocL [String
"."]) RewriteRule -> RewriteRule -> RewriteRule
`Then` [RewriteRule] -> RewriteRule
Or [
      -- sum xs --> foldl (+) 0 xs
      forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
xs -> MExpr
sumE MExpr -> MExpr -> MExpr
`a` MExpr
xs)
         (\MExpr
xs -> MExpr
foldlE MExpr -> MExpr -> MExpr
`a` MExpr
plusE MExpr -> MExpr -> MExpr
`a` MExpr
zeroE MExpr -> MExpr -> MExpr
`a` MExpr
xs),
      -- product xs --> foldl (*) 1 xs
      forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
xs -> MExpr
productE MExpr -> MExpr -> MExpr
`a` MExpr
xs)
         (\MExpr
xs -> MExpr
foldlE MExpr -> MExpr -> MExpr
`a` MExpr
multE MExpr -> MExpr -> MExpr
`a` MExpr
oneE MExpr -> MExpr -> MExpr
`a` MExpr
xs),
      -- foldl1 f (x:xs) --> foldl f x xs
      forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
x MExpr
xs -> MExpr
foldl1E MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` (MExpr
consE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
xs))
         (\MExpr
f MExpr
x MExpr
xs -> MExpr
foldlE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
xs),
      -- foldl f z (x:xs) --> foldl f (f z x) xs
      forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
z MExpr
x MExpr
xs -> (MExpr
foldlE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
z) MExpr -> MExpr -> MExpr
`a` (MExpr
consE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
xs))
         (\MExpr
f MExpr
z MExpr
x MExpr
xs -> MExpr
foldlE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` (MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
z MExpr -> MExpr -> MExpr
`a` MExpr
x) MExpr -> MExpr -> MExpr
`a` MExpr
xs),
      -- foldl f z [] --> z
      forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
z -> MExpr
foldlE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
z MExpr -> MExpr -> MExpr
`a` MExpr
nilE)
         (\MExpr
_ MExpr
z -> MExpr
z),
      -- special rule:
      -- foldl f z [x] --> f z x
      forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
z MExpr
x -> MExpr
foldlE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
z MExpr -> MExpr -> MExpr
`a` (MExpr
returnE MExpr -> MExpr -> MExpr
`a` MExpr
x))
         (\MExpr
f MExpr
z MExpr
x -> MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
z MExpr -> MExpr -> MExpr
`a` MExpr
x),
      forall a. RewriteC a => a -> a -> RewriteRule
rr (\MExpr
f MExpr
z MExpr
x -> MExpr
foldlE MExpr -> MExpr -> MExpr
`a` MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
z MExpr -> MExpr -> MExpr
`a` (MExpr
consE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
nilE))
         (\MExpr
f MExpr
z MExpr
x -> MExpr
f MExpr -> MExpr -> MExpr
`a` MExpr
z MExpr -> MExpr -> MExpr
`a` MExpr
x)
    ] RewriteRule -> RewriteRule -> RewriteRule
`OrElse` (
      -- (:) x --> (++) [x]
      RewriteRule -> RewriteRule
Opt (forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
x -> MExpr
consE MExpr -> MExpr -> MExpr
`a` MExpr
x)
         (\MExpr
x -> MExpr
appendE MExpr -> MExpr -> MExpr
`a` (MExpr
consE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
nilE))) RewriteRule -> RewriteRule -> RewriteRule
`Then`
      -- More special rule: (:) x . (++) ys --> (++) (x:ys)
      RewriteRule -> RewriteRule
up (forall a. RewriteC a => a -> a -> RewriteRule
rr0 (\MExpr
x MExpr
ys -> (MExpr
consE MExpr -> MExpr -> MExpr
`a` MExpr
x) MExpr -> MExpr -> MExpr
`c` (MExpr
appendE MExpr -> MExpr -> MExpr
`a` MExpr
ys))
         (\MExpr
x MExpr
ys -> MExpr
appendE MExpr -> MExpr -> MExpr
`a` (MExpr
consE MExpr -> MExpr -> MExpr
`a` MExpr
x MExpr -> MExpr -> MExpr
`a` MExpr
ys)))
      )
  ],

  -- Complicated Transformations
  (Expr -> Maybe Expr) -> RewriteRule
CRR (Expr -> Maybe Expr
collapseLists),
  RewriteRule -> RewriteRule
up forall a b. (a -> b) -> a -> b
$ [RewriteRule] -> RewriteRule
Or [(Expr -> Maybe Expr) -> RewriteRule
CRR ([(String, Unary)] -> Expr -> Maybe Expr
evalUnary [(String, Unary)]
unaryBuiltins), (Expr -> Maybe Expr) -> RewriteRule
CRR ([(String, Binary)] -> Expr -> Maybe Expr
evalBinary [(String, Binary)]
binaryBuiltins)],
  RewriteRule -> RewriteRule
up forall a b. (a -> b) -> a -> b
$ (Expr -> Maybe Expr) -> RewriteRule
CRR ([String] -> Expr -> Maybe Expr
assoc [String]
assocOps),
  RewriteRule -> RewriteRule
up forall a b. (a -> b) -> a -> b
$ (Expr -> Maybe Expr) -> RewriteRule
CRR ([String] -> Expr -> Maybe Expr
assocL [String]
assocOps),
  RewriteRule -> RewriteRule
up forall a b. (a -> b) -> a -> b
$ (Expr -> Maybe Expr) -> RewriteRule
CRR ([String] -> Expr -> Maybe Expr
assocR [String]
assocOps),
  RewriteRule -> RewriteRule -> RewriteRule
Up ((Expr -> Maybe Expr) -> RewriteRule
CRR ([String] -> Expr -> Maybe Expr
commutative [String]
commutativeOps)) forall a b. (a -> b) -> a -> b
$ RewriteRule -> RewriteRule
down forall a b. (a -> b) -> a -> b
$ [RewriteRule] -> RewriteRule
Or [(Expr -> Maybe Expr) -> RewriteRule
CRR forall a b. (a -> b) -> a -> b
$ [String] -> Expr -> Maybe Expr
assocL [String]
assocLOps,
                                                     (Expr -> Maybe Expr) -> RewriteRule
CRR forall a b. (a -> b) -> a -> b
$ [String] -> Expr -> Maybe Expr
assocR [String]
assocROps],

  RewriteRule -> RewriteRule
Hard forall a b. (a -> b) -> a -> b
$ RewriteRule
simplifies
  ] RewriteRule -> RewriteRule -> RewriteRule
`Then` RewriteRule -> RewriteRule
Opt (RewriteRule -> RewriteRule
up RewriteRule
simplifies)

----------------------------------------------------------------------------------------
-- Operator information

assocLOps, assocROps, assocOps :: [String]
assocLOps :: [String]
assocLOps = [String
"+", String
"*", String
"&&", String
"||", String
"max", String
"min"]
assocROps :: [String]
assocROps = [String
".", String
"++"]
assocOps :: [String]
assocOps  = [String]
assocLOps forall a. [a] -> [a] -> [a]
++ [String]
assocROps

commutativeOps :: [String]
commutativeOps :: [String]
commutativeOps = [String
"*", String
"+", String
"==", String
"/=", String
"max", String
"min"]

unaryBuiltins :: [(String,Unary)]
unaryBuiltins :: [(String, Unary)]
unaryBuiltins = [
    (String
"not",    forall a b. (Read a, Show a, Read b, Show b) => (a -> b) -> Unary
UA (Bool -> Bool
not    :: Bool -> Bool)),
    (String
"negate", forall a b. (Read a, Show a, Read b, Show b) => (a -> b) -> Unary
UA (forall a. Num a => a -> a
negate :: Integer -> Integer)),
    (String
"signum", forall a b. (Read a, Show a, Read b, Show b) => (a -> b) -> Unary
UA (forall a. Num a => a -> a
signum :: Integer -> Integer)),
    (String
"abs",    forall a b. (Read a, Show a, Read b, Show b) => (a -> b) -> Unary
UA (forall a. Num a => a -> a
abs    :: Integer -> Integer))
  ]

binaryBuiltins :: [(String,Binary)]
binaryBuiltins :: [(String, Binary)]
binaryBuiltins = [
    (String
"+",    forall a b c.
(Read a, Show a, Read b, Show b, Read c, Show c) =>
(a -> b -> c) -> Binary
BA (forall a. Num a => a -> a -> a
(+)  :: Integer -> Integer -> Integer)),
    (String
"-",    forall a b c.
(Read a, Show a, Read b, Show b, Read c, Show c) =>
(a -> b -> c) -> Binary
BA ((-)  :: Integer -> Integer -> Integer)),
    (String
"*",    forall a b c.
(Read a, Show a, Read b, Show b, Read c, Show c) =>
(a -> b -> c) -> Binary
BA (forall a. Num a => a -> a -> a
(*)  :: Integer -> Integer -> Integer)),
    (String
"^",    forall a b c.
(Read a, Show a, Read b, Show b, Read c, Show c) =>
(a -> b -> c) -> Binary
BA (forall a b. (Num a, Integral b) => a -> b -> a
(^)  :: Integer -> Integer -> Integer)),
    (String
"<",    forall a b c.
(Read a, Show a, Read b, Show b, Read c, Show c) =>
(a -> b -> c) -> Binary
BA (forall a. Ord a => a -> a -> Bool
(<)  :: Integer -> Integer -> Bool)),
    (String
">",    forall a b c.
(Read a, Show a, Read b, Show b, Read c, Show c) =>
(a -> b -> c) -> Binary
BA (forall a. Ord a => a -> a -> Bool
(>)  :: Integer -> Integer -> Bool)),
    (String
"==",   forall a b c.
(Read a, Show a, Read b, Show b, Read c, Show c) =>
(a -> b -> c) -> Binary
BA (forall a. Eq a => a -> a -> Bool
(==) :: Integer -> Integer -> Bool)),
    (String
"/=",   forall a b c.
(Read a, Show a, Read b, Show b, Read c, Show c) =>
(a -> b -> c) -> Binary
BA (forall a. Eq a => a -> a -> Bool
(/=) :: Integer -> Integer -> Bool)),
    (String
"<=",   forall a b c.
(Read a, Show a, Read b, Show b, Read c, Show c) =>
(a -> b -> c) -> Binary
BA (forall a. Ord a => a -> a -> Bool
(<=) :: Integer -> Integer -> Bool)),
    (String
">=",   forall a b c.
(Read a, Show a, Read b, Show b, Read c, Show c) =>
(a -> b -> c) -> Binary
BA (forall a. Ord a => a -> a -> Bool
(>=) :: Integer -> Integer -> Bool)),
    (String
"div",  forall a b c.
(Read a, Show a, Read b, Show b, Read c, Show c) =>
(a -> b -> c) -> Binary
BA (forall a. Integral a => a -> a -> a
div  :: Integer -> Integer -> Integer)),
    (String
"mod",  forall a b c.
(Read a, Show a, Read b, Show b, Read c, Show c) =>
(a -> b -> c) -> Binary
BA (forall a. Integral a => a -> a -> a
mod  :: Integer -> Integer -> Integer)),
    (String
"max",  forall a b c.
(Read a, Show a, Read b, Show b, Read c, Show c) =>
(a -> b -> c) -> Binary
BA (forall a. Ord a => a -> a -> a
max  :: Integer -> Integer -> Integer)),
    (String
"min",  forall a b c.
(Read a, Show a, Read b, Show b, Read c, Show c) =>
(a -> b -> c) -> Binary
BA (forall a. Ord a => a -> a -> a
min  :: Integer -> Integer -> Integer)),
    (String
"&&",   forall a b c.
(Read a, Show a, Read b, Show b, Read c, Show c) =>
(a -> b -> c) -> Binary
BA (Bool -> Bool -> Bool
(&&) :: Bool -> Bool -> Bool)),
    (String
"||",   forall a b c.
(Read a, Show a, Read b, Show b, Read c, Show c) =>
(a -> b -> c) -> Binary
BA (Bool -> Bool -> Bool
(||) :: Bool -> Bool -> Bool))
  ]