{-# 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
(MExpr -> MExpr -> Bool) -> (MExpr -> MExpr -> Bool) -> Eq MExpr
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 :: MExpr -> Int -> Rewrite
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 (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ ExprArr
xs ExprArr -> Int -> Expr
forall i e. Ix i => Array i e -> i -> e
! Int
h
myFire ExprArr
_ MExpr
me = MExpr
me

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

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

match :: Rewrite -> Expr -> Maybe ExprArr
match :: Rewrite -> Expr -> Maybe ExprArr
match (Rewrite MExpr
hl Int
rid') Expr
e  = Int -> [(Int, Expr)] -> Maybe ExprArr
forall v. Ord v => Int -> [(Int, v)] -> Maybe (Array Int v)
uniqueArray Int
rid' ([(Int, Expr)] -> Maybe ExprArr)
-> Maybe [(Int, Expr)] -> Maybe ExprArr
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 (MExpr -> Expr) -> (ExprArr -> MExpr) -> ExprArr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rewrite -> ExprArr -> MExpr
fire' Rewrite
r2) (ExprArr -> Expr) -> Maybe ExprArr -> Maybe Expr
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') = 
  ([(Int, Expr)] -> [(Int, Expr)] -> [(Int, Expr)])
-> Maybe [(Int, Expr)]
-> Maybe [(Int, Expr)]
-> Maybe [(Int, Expr)]
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 [(Int, Expr)] -> [(Int, Expr)] -> [(Int, Expr)]
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 Expr -> Expr -> Bool
forall a. Eq a => a -> a -> Bool
== Expr
e' then [(Int, Expr)] -> Maybe [(Int, Expr)]
forall a. a -> Maybe a
Just [] else Maybe [(Int, Expr)]
forall a. Maybe a
Nothing
matchWith (Hole Int
k) Expr
e = [(Int, Expr)] -> Maybe [(Int, Expr)]
forall a. a -> Maybe a
Just [(Int
k,Expr
e)]
matchWith MExpr
_ Expr
_ = Maybe [(Int, 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 :: MExpr -> Int -> Rewrite
Rewrite {
    holes :: MExpr
holes = Rewrite -> MExpr
holes (Rewrite -> MExpr) -> (Int -> Rewrite) -> Int -> MExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Rewrite
forall a. RewriteC a => a -> Rewrite
getRewrite (a -> Rewrite) -> (Int -> a) -> Int -> Rewrite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MExpr -> a
rule (MExpr -> a) -> (Int -> MExpr) -> Int -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> MExpr
Hole (Int -> MExpr) -> Int -> MExpr
forall a b. (a -> b) -> a -> b
$ Int
pid,
    rid :: Int
rid   = Int
pid Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
  } where 
    pid :: Int
pid = Rewrite -> Int
rid (Rewrite -> Int) -> Rewrite -> Int
forall a b. (a -> b) -> a -> b
$ a -> Rewrite
forall a. RewriteC a => a -> Rewrite
getRewrite (a
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 Int -> Int -> Bool
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' Int -> Int -> Bool
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 Int -> Int -> Bool
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1    = Rewrite
r Rewrite -> [Rewrite] -> [Rewrite]
forall a. a -> [a] -> [a]
: Rewrite -> [Rewrite]
getVariants (MExpr -> Int -> Rewrite
Rewrite MExpr
e' (Int
nkInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1))
    | Bool
otherwise  = String -> [Rewrite]
forall a. HasCallStack => String -> a
error String
"getVariants' : nk went negative"
    where
        e' :: MExpr
e' = MExpr -> MExpr
decHoles (MExpr -> MExpr) -> MExpr -> MExpr
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'Int -> Int -> Int
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 :: a -> a -> [RewriteRule]
rrList a
r1 a
r2 = (Rewrite -> Rewrite -> RewriteRule)
-> [Rewrite] -> [Rewrite] -> [RewriteRule]
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' = a -> Rewrite
forall a. RewriteC a => a -> Rewrite
getRewrite a
r1
  r2' :: Rewrite
r2' = a -> Rewrite
forall a. RewriteC a => a -> Rewrite
getRewrite a
r2

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

-- use only this rewrite rule
rr0 :: a -> a -> RewriteRule
rr0 a
r1 a
r2 = Rewrite -> Rewrite -> RewriteRule
RR Rewrite
r1' Rewrite
r2' where
  r1' :: Rewrite
r1' = a -> Rewrite
forall a. RewriteC a => a -> Rewrite
getRewrite a
r1
  r2' :: Rewrite
r2' = a -> Rewrite
forall a. RewriteC a => a -> Rewrite
getRewrite a
r2
  
down, up :: RewriteRule -> RewriteRule
down :: RewriteRule -> RewriteRule
down = (RewriteRule -> RewriteRule) -> RewriteRule
forall a. (a -> a) -> a
fix ((RewriteRule -> RewriteRule) -> RewriteRule)
-> (RewriteRule -> RewriteRule -> RewriteRule)
-> RewriteRule
-> RewriteRule
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewriteRule -> RewriteRule -> RewriteRule
Down
up :: RewriteRule -> RewriteRule
up   = (RewriteRule -> RewriteRule) -> RewriteRule
forall a. (a -> a) -> a
fix ((RewriteRule -> RewriteRule) -> RewriteRule)
-> (RewriteRule -> RewriteRule -> RewriteRule)
-> RewriteRule
-> RewriteRule
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 (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"id"
flipE :: MExpr
flipE      = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"flip"
constE :: MExpr
constE     = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"const"
compE :: MExpr
compE      = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf String
"."
sE :: MExpr
sE         = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"ap"
fixE :: MExpr
fixE       = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"fix"
bindE :: MExpr
bindE      = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
">>="
extE :: MExpr
extE       = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"=<<"
returnE :: MExpr
returnE    = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"return"
consE :: MExpr
consE      = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
":"
nilE :: MExpr
nilE       = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"[]"
appendE :: MExpr
appendE    = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"++"
foldrE :: MExpr
foldrE     = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"foldr"
foldlE :: MExpr
foldlE     = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"foldl"
fstE :: MExpr
fstE       = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"fst"
sndE :: MExpr
sndE       = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"snd"
dollarE :: MExpr
dollarE    = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"$"
uncurryE :: MExpr
uncurryE   = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"uncurry"
curryE :: MExpr
curryE     = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"curry"
headE :: MExpr
headE      = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"head"
tailE :: MExpr
tailE      = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"tail"
commaE :: MExpr
commaE     = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
","
foldl1E :: MExpr
foldl1E    = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"foldl1"
equalsE :: MExpr
equalsE    = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"=="
nequalsE :: MExpr
nequalsE   = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"/="
notE :: MExpr
notE       = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"not"
plusE :: MExpr
plusE      = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"+"
multE :: MExpr
multE      = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"*"
zeroE :: MExpr
zeroE      = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"0"
oneE :: MExpr
oneE       = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"1"
lengthE :: MExpr
lengthE    = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"length"
sumE :: MExpr
sumE       = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"sum"
productE :: MExpr
productE   = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"product"
concatE :: MExpr
concatE    = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"concat"
concatMapE :: MExpr
concatMapE = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"concatMap"
joinE :: MExpr
joinE      = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"join"
mapE :: MExpr
mapE       = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"map"
fmapE :: MExpr
fmapE      = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"fmap"
fmapIE :: MExpr
fmapIE     = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"fmap"
subtractE :: MExpr
subtractE  = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"subtract"
minusE :: MExpr
minusE     = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"-"
liftME :: MExpr
liftME     = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"liftM"
liftM2E :: MExpr
liftM2E    = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"liftM2"
apE :: MExpr
apE        = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"ap"
seqME :: MExpr
seqME      = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
">>"
zipE :: MExpr
zipE       = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"zip"
zipWithE :: MExpr
zipWithE   = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"zipWith"
crossE :: MExpr
crossE     = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Inf  String
"***"
firstE :: MExpr
firstE     = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"first"
secondE :: MExpr
secondE    = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"second"
andE :: MExpr
andE       = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"and"
orE :: MExpr
orE        = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"or"
allE :: MExpr
allE       = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
forall a b. (a -> b) -> a -> b
$ Fixity -> String -> Expr
Var Fixity
Pref String
"all"
anyE :: MExpr
anyE       = Expr -> MExpr
Quote (Expr -> MExpr) -> Expr -> MExpr
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
xExpr -> Expr -> Bool
forall a. Eq a => a -> a -> Bool
==Expr
nil,
    ([Expr]
ys,Expr
y) <- Expr -> ([Expr], Expr)
getList Expr
e2, Expr
yExpr -> Expr -> Bool
forall a. Eq a => a -> a -> Bool
==Expr
nil = Expr -> Maybe Expr
forall a. a -> Maybe a
Just (Expr -> Maybe Expr) -> Expr -> Maybe Expr
forall a b. (a -> b) -> a -> b
$ [Expr] -> Expr
makeList ([Expr] -> Expr) -> [Expr] -> Expr
forall a b. (a -> b) -> a -> b
$ [Expr]
xs [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++ [Expr]
ys
collapseLists Expr
_ = Maybe 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) <- String -> [(String, Binary)] -> Maybe Binary
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
f' [(String, Binary)]
fs = (Fixity -> String -> Expr
Var Fixity
Pref (String -> Expr) -> (c -> String) -> c -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> String
forall a. Show a => a -> String
show) (c -> Expr) -> Maybe c -> Maybe Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (a -> b -> c) -> Maybe a -> Maybe b -> Maybe c
forall (m :: * -> *) a1 a2 r.
Monad m =>
(a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM2 a -> b -> c
f (String -> Maybe a
forall a. Read a => String -> Maybe a
readM String
x') (String -> Maybe b
forall a. Read a => String -> Maybe a
readM String
y')
evalBinary [(String, Binary)]
_ Expr
_ = Maybe 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) <- String -> [(String, Unary)] -> Maybe Unary
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
f' [(String, Unary)]
fs = (Fixity -> String -> Expr
Var Fixity
Pref (String -> Expr) -> (a -> String) -> a -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> String
forall a. Show a => a -> String
show (b -> String) -> (a -> b) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) (a -> Expr) -> Maybe a -> Maybe Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` String -> Maybe a
forall a. Read a => String -> Maybe a
readM String
x'
evalUnary [(String, Unary)]
_ Expr
_ = Maybe 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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
op2 Bool -> Bool -> Bool
&& String
op1 String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ops 
  = Expr -> Maybe Expr
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
_ = Maybe 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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
op2 Bool -> Bool -> Bool
&& String
op1 String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ops 
  = Expr -> Maybe Expr
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
_ = Maybe 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 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
op2 Bool -> Bool -> Bool
&& String
op1 String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ops
  = Expr -> Maybe Expr
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
_ = Maybe 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 String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ops = Expr -> Maybe Expr
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 String -> [String] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
ops = Expr -> Maybe Expr
forall a. a -> Maybe a
Just Expr
e
commutative [String]
_ Expr
_ = Maybe 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)
  (MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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
  MExpr -> MExpr -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr (MExpr
curryE MExpr -> MExpr -> MExpr
`a` MExpr
fstE) (MExpr
constE),
  -- curry snd --> const id
  MExpr -> MExpr -> RewriteRule
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)
  (MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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 (=<<) --> (>>=)
  MExpr -> MExpr -> RewriteRule
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
  MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr (MExpr
fmapE MExpr -> MExpr -> MExpr
`a` MExpr
idE)
     (MExpr
idE),
  -- map id --> id
  MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr (MExpr
mapE MExpr -> MExpr -> MExpr
`a` MExpr
idE)
     (MExpr
idE),
  -- (f . g) . h --> f . (g . h)
  (MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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)
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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)
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$ [RewriteRule] -> RewriteRule
Or [
  -- ($) --> id
  MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr0 (MExpr
dollarE)
      MExpr
idE,
  -- concatMap --> (=<<)
  MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
concatMapE MExpr
extE,
  -- concat    --> join
  MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
concatE MExpr
joinE,
  -- liftM --> fmap
  MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
liftME MExpr
fmapE,
  -- map --> fmap
  MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
mapE MExpr
fmapE,
  -- subtract -> flip (-)
  MExpr -> MExpr -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$
  (MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$
  MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr  MExpr
bindE
      (MExpr
flipE MExpr -> MExpr -> MExpr
`a` MExpr
extE),
  -- (.) id --> id
  MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr (MExpr
compE MExpr -> MExpr -> MExpr
`a` MExpr
idE)
     MExpr
idE,
  -- (++) [x] --> (:) x
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr  (MExpr
extE MExpr -> MExpr -> MExpr
`a` MExpr
returnE)
      MExpr
idE,
  -- (=<<) f (return x) -> f x
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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 
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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)
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  MExpr -> MExpr -> RewriteRule
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
  MExpr -> MExpr -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$ 
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$ 
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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 [MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
plusE MExpr
plusE, MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
minusE MExpr
minusE, MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
multE MExpr
multE]) (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$ RewriteRule -> RewriteRule
down (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$ [RewriteRule] -> RewriteRule
Or [
    -- 0 + x --> x
    (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
    (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
    (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
    (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
    (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
    (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
    (MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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
    (MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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
    (MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr (MExpr
extE MExpr -> MExpr -> MExpr
`a` MExpr
idE) MExpr
joinE,
  -- join --> (=<<) id
  RewriteRule -> RewriteRule
Hard (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$
  MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
joinE (MExpr
extE MExpr -> MExpr -> MExpr
`a` MExpr
idE),
  -- join (return x) --> x
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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)
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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)
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$ 
  MExpr -> MExpr -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$
  (MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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 (,)
  MExpr -> MExpr -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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)
  (MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$ -- ??
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
  MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr (MExpr
uncurryE MExpr -> MExpr -> MExpr
`a` MExpr
constE)
     (MExpr
fstE),
  -- uncurry (const . f) --> f . fst
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$
  (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$ 
  RewriteRule -> RewriteRule -> RewriteRule
If ([RewriteRule] -> RewriteRule
Or [MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
consE MExpr
consE, MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr MExpr
nilE MExpr
nilE]) (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$ [RewriteRule] -> RewriteRule
Or [
    RewriteRule -> RewriteRule
down (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$ [RewriteRule] -> RewriteRule
Or [
      -- length [] --> 0
      MExpr -> MExpr -> RewriteRule
forall a. RewriteC a => a -> a -> RewriteRule
rr (MExpr
lengthE MExpr -> MExpr -> MExpr
`a` MExpr
nilE)
         MExpr
zeroE,
      -- length (x:xs) --> 1 + length xs
      (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$ [RewriteRule] -> RewriteRule
Or [
      -- map f (x:xs) --> f x: map f xs
      (MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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
      (MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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 []     --> []
      (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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 []     --> []
      (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$ [RewriteRule] -> RewriteRule
Or [
      -- foldr f z (x:xs) --> f x (foldr f z xs)
      (MExpr -> MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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
      (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$ RewriteRule -> RewriteRule
Opt ((Expr -> Maybe Expr) -> RewriteRule
CRR ((Expr -> Maybe Expr) -> RewriteRule)
-> (Expr -> Maybe Expr) -> RewriteRule
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
      (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
      (MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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
      (MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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
      (MExpr -> MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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
      (MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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
      (MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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),
      (MExpr -> MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr -> MExpr) -> RewriteRule
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 ((MExpr -> MExpr) -> (MExpr -> MExpr) -> RewriteRule
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 ((MExpr -> MExpr -> MExpr)
-> (MExpr -> MExpr -> MExpr) -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
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 (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$ (Expr -> Maybe Expr) -> RewriteRule
CRR ([String] -> Expr -> Maybe Expr
assoc [String]
assocOps),
  RewriteRule -> RewriteRule
up (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$ (Expr -> Maybe Expr) -> RewriteRule
CRR ([String] -> Expr -> Maybe Expr
assocL [String]
assocOps),
  RewriteRule -> RewriteRule
up (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
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)) (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$ RewriteRule -> RewriteRule
down (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
forall a b. (a -> b) -> a -> b
$ [RewriteRule] -> RewriteRule
Or [(Expr -> Maybe Expr) -> RewriteRule
CRR ((Expr -> Maybe Expr) -> RewriteRule)
-> (Expr -> Maybe Expr) -> RewriteRule
forall a b. (a -> b) -> a -> b
$ [String] -> Expr -> Maybe Expr
assocL [String]
assocLOps,
                                                     (Expr -> Maybe Expr) -> RewriteRule
CRR ((Expr -> Maybe Expr) -> RewriteRule)
-> (Expr -> Maybe Expr) -> RewriteRule
forall a b. (a -> b) -> a -> b
$ [String] -> Expr -> Maybe Expr
assocR [String]
assocROps],

  RewriteRule -> RewriteRule
Hard (RewriteRule -> RewriteRule) -> RewriteRule -> RewriteRule
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 [String] -> [String] -> [String]
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",    (Bool -> Bool) -> Unary
forall a b. (Read a, Show a, Read b, Show b) => (a -> b) -> Unary
UA (Bool -> Bool
not    :: Bool -> Bool)),
    (String
"negate", (Integer -> Integer) -> Unary
forall a b. (Read a, Show a, Read b, Show b) => (a -> b) -> Unary
UA (Integer -> Integer
forall a. Num a => a -> a
negate :: Integer -> Integer)),
    (String
"signum", (Integer -> Integer) -> Unary
forall a b. (Read a, Show a, Read b, Show b) => (a -> b) -> Unary
UA (Integer -> Integer
forall a. Num a => a -> a
signum :: Integer -> Integer)),
    (String
"abs",    (Integer -> Integer) -> Unary
forall a b. (Read a, Show a, Read b, Show b) => (a -> b) -> Unary
UA (Integer -> Integer
forall a. Num a => a -> a
abs    :: Integer -> Integer))
  ]

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