{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
--
-- | This marvellous module contributed by Thomas J\344ger
--
module Plugin.Pl.Rules (RewriteRule(..), rules, fire) where

import Plugin.Pl.Common

import Data.Array
import qualified Data.Set as S

import Control.Monad.Fix (fix)

--import PlModule.PrettyPrinter

-- Next time I do somthing like this, I'll actually think about the combinator
-- language before, instead of producing something ad-hoc like this:
data RewriteRule 
  = RR Rewrite Rewrite
  | CRR (Expr -> Maybe Expr)
  | Down RewriteRule RewriteRule
  | Up RewriteRule RewriteRule
  | Or [RewriteRule]
  | OrElse RewriteRule RewriteRule
  | Then RewriteRule RewriteRule
  | Opt RewriteRule
  | If RewriteRule RewriteRule
  | Hard RewriteRule

-- No MLambda here because we only consider closed Terms (no alpha-renaming!).
data MExpr
  = MApp !MExpr !MExpr
  | Hole !Int
  | Quote !Expr
  deriving MExpr -> MExpr -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MExpr -> MExpr -> Bool
$c/= :: MExpr -> MExpr -> Bool
== :: MExpr -> MExpr -> Bool
$c== :: MExpr -> MExpr -> Bool
Eq

--instance Show MExpr where
--  show = show . fromMExpr

data Rewrite = Rewrite {
  Rewrite -> MExpr
holes :: MExpr,
  Rewrite -> Int
rid :: Int -- rlength - 1
} --deriving Show

-- What are you gonna do when no recursive modules are possible?
class RewriteC a where
  getRewrite :: a -> Rewrite 

instance RewriteC MExpr where
  getRewrite :: MExpr -> Rewrite
getRewrite MExpr
rule = Rewrite {
    holes :: MExpr
holes   = MExpr
rule,
    rid :: Int
rid = Int
0
  }

type ExprArr = Array Int Expr

myFire :: ExprArr -> MExpr -> MExpr
myFire :: ExprArr -> MExpr -> MExpr
myFire ExprArr
xs (MApp MExpr
e1 MExpr
e2) = MExpr -> MExpr -> MExpr
MApp (ExprArr -> MExpr -> MExpr
myFire ExprArr
xs MExpr
e1) (ExprArr -> MExpr -> MExpr
myFire ExprArr
xs MExpr
e2)
myFire ExprArr
xs (Hole Int
h) = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ ExprArr
xs forall i e. Ix i => Array i e -> i -> e
! Int
h
myFire ExprArr
_ MExpr
me = MExpr
me

nub' :: Ord a => [a] -> [a]
nub' :: forall a. Ord a => [a] -> [a]
nub' = forall a. Set a -> [a]
S.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
S.fromList

uniqueArray :: Ord v => Int -> [(Int, v)] -> Maybe (Array Int v)
uniqueArray :: forall v. Ord v => Int -> [(Int, v)] -> Maybe (Array Int v)
uniqueArray Int
n [(Int, v)]
lst 
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Ord a => [a] -> [a]
nub' [(Int, v)]
lst) forall a. Eq a => a -> a -> Bool
== Int
n = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array (Int
0,Int
nforall a. Num a => a -> a -> a
-Int
1) [(Int, v)]
lst
  | Bool
otherwise = forall a. Maybe a
Nothing              

match :: Rewrite -> Expr -> Maybe ExprArr
match :: Rewrite -> Expr -> Maybe ExprArr
match (Rewrite MExpr
hl Int
rid') Expr
e  = forall v. Ord v => Int -> [(Int, v)] -> Maybe (Array Int v)
uniqueArray Int
rid' forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< MExpr -> Expr -> Maybe [(Int, Expr)]
matchWith MExpr
hl Expr
e

fire' :: Rewrite -> ExprArr -> MExpr
fire' :: Rewrite -> ExprArr -> MExpr
fire' (Rewrite MExpr
hl Int
_)   = (ExprArr -> MExpr -> MExpr
`myFire` MExpr
hl)

fire :: Rewrite -> Rewrite -> Expr -> Maybe Expr
fire :: Rewrite -> Rewrite -> Expr -> Maybe Expr
fire Rewrite
r1 Rewrite
r2 Expr
e = (MExpr -> Expr
fromMExpr forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rewrite -> ExprArr -> MExpr
fire' Rewrite
r2) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Rewrite -> Expr -> Maybe ExprArr
match Rewrite
r1 Expr
e

matchWith :: MExpr -> Expr -> Maybe [(Int, Expr)]
matchWith :: MExpr -> Expr -> Maybe [(Int, Expr)]
matchWith (MApp MExpr
e1 MExpr
e2) (App Expr
e1' Expr
e2') = 
  forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 forall a. [a] -> [a] -> [a]
(++) (MExpr -> Expr -> Maybe [(Int, Expr)]
matchWith MExpr
e1 Expr
e1') (MExpr -> Expr -> Maybe [(Int, Expr)]
matchWith MExpr
e2 Expr
e2')
matchWith (Quote Expr
e) Expr
e' = if Expr
e forall a. Eq a => a -> a -> Bool
== Expr
e' then forall a. a -> Maybe a
Just [] else forall a. Maybe a
Nothing
matchWith (Hole Int
k) Expr
e = forall a. a -> Maybe a
Just [(Int
k,Expr
e)]
matchWith MExpr
_ Expr
_ = forall a. Maybe a
Nothing

fromMExpr :: MExpr -> Expr
fromMExpr :: MExpr -> Expr
fromMExpr (MApp MExpr
e1 MExpr
e2)  = Expr -> Expr -> Expr
App (MExpr -> Expr
fromMExpr MExpr
e1) (MExpr -> Expr
fromMExpr MExpr
e2)
fromMExpr (Hole Int
_)      = Fixity -> String -> Expr
Var Fixity
Pref String
"Hole" -- error "Hole in MExpr"
fromMExpr (Quote Expr
e)     = Expr
e

instance RewriteC a => RewriteC (MExpr -> a) where
  getRewrite :: (MExpr -> a) -> Rewrite
getRewrite MExpr -> a
rule = Rewrite {
    holes :: MExpr
holes = Rewrite -> MExpr
holes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. RewriteC a => a -> Rewrite
getRewrite forall b c a. (b -> c) -> (a -> b) -> a -> c
. MExpr -> a
rule forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> MExpr
Hole forall a b. (a -> b) -> a -> b
$ Int
pid,
    rid :: Int
rid   = Int
pid forall a. Num a => a -> a -> a
+ Int
1
  } where 
    pid :: Int
pid = Rewrite -> Int
rid forall a b. (a -> b) -> a -> b
$ forall a. RewriteC a => a -> Rewrite
getRewrite (forall a. a
bt :: a)

-- Yet another pointless transformation
transformM :: Int -> MExpr -> MExpr
transformM :: Int -> MExpr -> MExpr
transformM Int
_ (Quote Expr
e) = MExpr
constE MExpr -> MExpr -> MExpr
`a` Expr -> MExpr
Quote Expr
e
transformM Int
n (Hole Int
n') = if Int
n forall a. Eq a => a -> a -> Bool
== Int
n' then MExpr
idE else MExpr
constE MExpr -> MExpr -> MExpr
`a` Int -> MExpr
Hole Int
n'
transformM Int
n (Quote (Var Fixity
_ String
".") `MApp` MExpr
e1 `MApp` MExpr
e2)
  | MExpr
e1 MExpr -> Int -> Bool
`hasHole` Int
n Bool -> Bool -> Bool
&& Bool -> Bool
not (MExpr
e2 MExpr -> Int -> Bool
`hasHole` Int
n) 
  = MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
compE MExpr -> MExpr -> MExpr
`a` MExpr
e2 MExpr -> MExpr -> MExpr
`c` Int -> MExpr -> MExpr
transformM Int
n MExpr
e1
transformM Int
n e :: MExpr
e@(MApp MExpr
e1 MExpr
e2) 
  | Bool
fr1 Bool -> Bool -> Bool
&& Bool
fr2 = MExpr
sE MExpr -> MExpr -> MExpr
`a` Int -> MExpr -> MExpr
transformM Int
n MExpr
e1 MExpr -> MExpr -> MExpr
`a` Int -> MExpr -> MExpr
transformM Int
n MExpr
e2
  | Bool
fr1        = MExpr
flipE MExpr -> MExpr -> MExpr
`a` Int -> MExpr -> MExpr
transformM Int
n MExpr
e1 MExpr -> MExpr -> MExpr
`a` MExpr
e2
  | Bool
fr2, Hole Int
n' <- MExpr
e2, Int
n' forall a. Eq a => a -> a -> Bool
== Int
n = MExpr
e1
  | Bool
fr2        = MExpr
e1 MExpr -> MExpr -> MExpr
`c` Int -> MExpr -> MExpr
transformM Int
n MExpr
e2
  | Bool
otherwise  = MExpr
constE MExpr -> MExpr -> MExpr
`a` MExpr
e
  where
    fr1 :: Bool
fr1 = MExpr
e1 MExpr -> Int -> Bool
`hasHole` Int
n
    fr2 :: Bool
fr2 = MExpr
e2 MExpr -> Int -> Bool
`hasHole` Int
n

hasHole :: MExpr -> Int -> Bool
hasHole :: MExpr -> Int -> Bool
hasHole (MApp MExpr
e1 MExpr
e2) Int
n = MExpr
e1 MExpr -> Int -> Bool
`hasHole` Int
n Bool -> Bool -> Bool
|| MExpr
e2 MExpr -> Int -> Bool
`hasHole` Int
n
hasHole (Quote Expr
_)   Int
_ = Bool
False
hasHole (Hole Int
n')   Int
n = Int
n forall a. Eq a => a -> a -> Bool
== Int
n'

--
-- haddock doesn't like n+k patterns, so rewrite them
--
getVariants, getVariants' :: Rewrite -> [Rewrite]
getVariants' :: Rewrite -> [Rewrite]
getVariants' r :: Rewrite
r@(Rewrite MExpr
_ Int
0)  = [Rewrite
r]
getVariants' r :: Rewrite
r@(Rewrite MExpr
e Int
nk)
    | Int
nk forall a. Ord a => a -> a -> Bool
>= Int
1    = Rewrite
r forall a. a -> [a] -> [a]
: Rewrite -> [Rewrite]
getVariants (MExpr -> Int -> Rewrite
Rewrite MExpr
e' (Int
nkforall a. Num a => a -> a -> a
-Int
1))
    | Bool
otherwise  = forall a. HasCallStack => String -> a
error String
"getVariants' : nk went negative"
    where
        e' :: MExpr
e' = MExpr -> MExpr
decHoles forall a b. (a -> b) -> a -> b
$ Int -> MExpr -> MExpr
transformM Int
0 MExpr
e

        decHoles :: MExpr -> MExpr
decHoles (Hole Int
n')    = Int -> MExpr
Hole (Int
n'forall a. Num a => a -> a -> a
-Int
1)
        decHoles (MApp MExpr
e1 MExpr
e2) = MExpr -> MExpr
decHoles MExpr
e1 MExpr -> MExpr -> MExpr
`MApp` MExpr -> MExpr
decHoles MExpr
e2
        decHoles MExpr
me           = MExpr
me

getVariants :: Rewrite -> [Rewrite]
getVariants = Rewrite -> [Rewrite]
getVariants' -- r = trace (show vs) vs where vs = getVariants' r

rr, rr0, rr1, rr2 :: RewriteC a => a -> a -> RewriteRule
-- use this rewrite rule and rewrite rules derived from it by iterated
-- pointless transformation
rrList :: RewriteC a => a -> a -> [RewriteRule]
rrList :: forall a. RewriteC a => a -> a -> [RewriteRule]
rrList a
r1 a
r2 = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Rewrite -> Rewrite -> RewriteRule
RR (Rewrite -> [Rewrite]
getVariants Rewrite
r1') (Rewrite -> [Rewrite]
getVariants Rewrite
r2') where
  r1' :: Rewrite
r1' = forall a. RewriteC a => a -> Rewrite
getRewrite a
r1
  r2' :: Rewrite
r2' = forall a. RewriteC a => a -> Rewrite
getRewrite a
r2

rr :: forall a. RewriteC a => a -> a -> RewriteRule
rr  a
r1 a
r2 = [RewriteRule] -> RewriteRule
Or          forall a b. (a -> b) -> a -> b
$ forall a. RewriteC a => a -> a -> [RewriteRule]
rrList a
r1 a
r2
rr1 :: forall a. RewriteC a => a -> a -> RewriteRule
rr1 a
r1 a
r2 = [RewriteRule] -> RewriteRule
Or forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
2 forall a b. (a -> b) -> a -> b
$ forall a. RewriteC a => a -> a -> [RewriteRule]
rrList a
r1 a
r2
rr2 :: forall a. RewriteC a => a -> a -> RewriteRule
rr2 a
r1 a
r2 = [RewriteRule] -> RewriteRule
Or forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ forall a. RewriteC a => a -> a -> [RewriteRule]
rrList a
r1 a
r2

-- use only this rewrite rule
rr0 :: forall a. RewriteC a => a -> a -> RewriteRule
rr0 a
r1 a
r2 = Rewrite -> Rewrite -> RewriteRule
RR Rewrite
r1' Rewrite
r2' where
  r1' :: Rewrite
r1' = forall a. RewriteC a => a -> Rewrite
getRewrite a
r1
  r2' :: Rewrite
r2' = forall a. RewriteC a => a -> Rewrite
getRewrite a
r2
  
down, up :: RewriteRule -> RewriteRule
down :: RewriteRule -> RewriteRule
down = forall a. (a -> a) -> a
fix forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewriteRule -> RewriteRule -> RewriteRule
Down
up :: RewriteRule -> RewriteRule
up   = forall a. (a -> a) -> a
fix forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewriteRule -> RewriteRule -> RewriteRule
Up


idE, flipE, bindE, extE, returnE, consE, appendE, nilE, foldrE, foldlE, fstE,
  sndE, dollarE, constE, uncurryE, curryE, compE, headE, tailE, sE, commaE, 
  fixE, foldl1E, notE, equalsE, nequalsE, plusE, multE, zeroE, oneE, lengthE, 
  sumE, productE, concatE, concatMapE, joinE, mapE, fmapE, fmapIE, subtractE, 
  minusE, liftME, apE, liftM2E, seqME, zipE, zipWithE, 
  crossE, firstE, secondE, andE, orE, allE, anyE :: MExpr
idE :: MExpr
idE        = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"id"
flipE :: MExpr
flipE      = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"flip"
constE :: MExpr
constE     = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"const"
compE :: MExpr
compE      = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf String
"."
sE :: MExpr
sE         = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"ap"
fixE :: MExpr
fixE       = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"fix"
bindE :: MExpr
bindE      = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
">>="
extE :: MExpr
extE       = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"=<<"
returnE :: MExpr
returnE    = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"return"
consE :: MExpr
consE      = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
":"
nilE :: MExpr
nilE       = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"[]"
appendE :: MExpr
appendE    = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"++"
foldrE :: MExpr
foldrE     = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"foldr"
foldlE :: MExpr
foldlE     = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"foldl"
fstE :: MExpr
fstE       = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"fst"
sndE :: MExpr
sndE       = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"snd"
dollarE :: MExpr
dollarE    = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"$"
uncurryE :: MExpr
uncurryE   = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"uncurry"
curryE :: MExpr
curryE     = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"curry"
headE :: MExpr
headE      = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"head"
tailE :: MExpr
tailE      = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"tail"
commaE :: MExpr
commaE     = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
","
foldl1E :: MExpr
foldl1E    = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"foldl1"
equalsE :: MExpr
equalsE    = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"=="
nequalsE :: MExpr
nequalsE   = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"/="
notE :: MExpr
notE       = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"not"
plusE :: MExpr
plusE      = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"+"
multE :: MExpr
multE      = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"*"
zeroE :: MExpr
zeroE      = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"0"
oneE :: MExpr
oneE       = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"1"
lengthE :: MExpr
lengthE    = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"length"
sumE :: MExpr
sumE       = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"sum"
productE :: MExpr
productE   = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"product"
concatE :: MExpr
concatE    = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"concat"
concatMapE :: MExpr
concatMapE = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"concatMap"
joinE :: MExpr
joinE      = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"join"
mapE :: MExpr
mapE       = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"map"
fmapE :: MExpr
fmapE      = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"fmap"
fmapIE :: MExpr
fmapIE     = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"fmap"
subtractE :: MExpr
subtractE  = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"subtract"
minusE :: MExpr
minusE     = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"-"
liftME :: MExpr
liftME     = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"liftM"
liftM2E :: MExpr
liftM2E    = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"liftM2"
apE :: MExpr
apE        = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"ap"
seqME :: MExpr
seqME      = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
">>"
zipE :: MExpr
zipE       = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"zip"
zipWithE :: MExpr
zipWithE   = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"zipWith"
crossE :: MExpr
crossE     = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"***"
firstE :: MExpr
firstE     = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"first"
secondE :: MExpr
secondE    = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"second"
andE :: MExpr
andE       = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"and"
orE :: MExpr
orE        = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"or"
allE :: MExpr
allE       = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"all"
anyE :: MExpr
anyE       = Expr -> MExpr
Quote forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"any"



a, c :: MExpr -> MExpr -> MExpr
a :: MExpr -> MExpr -> MExpr
a       = MExpr -> MExpr -> MExpr
MApp
c :: MExpr -> MExpr -> MExpr
c MExpr
e1 MExpr
e2 = MExpr
compE MExpr -> MExpr -> MExpr
`a` MExpr
e1 MExpr -> MExpr -> MExpr
`a` MExpr
e2
infixl 9 `a`
infixr 8 `c`


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. Read a => String -> Maybe a
readM String
x') (forall a. Read a => String -> Maybe 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. Read a => String -> Maybe 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

-- 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),
  -- 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),
  -- 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 --> x
  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
_ MExpr
x -> MExpr
x),
  -- 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 performace)
  -- 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)
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))
  ]