module Parser.Rw ( rewrite
                 ) where

import           A

rewrite :: E a -> E a
rewrite = E a -> E a
forall a. E a -> E a
rw

isBinOp :: Builtin -> Bool
isBinOp :: Builtin -> Bool
isBinOp Builtin
FRange = Bool
False
isBinOp Builtin
IRange = Bool
False
isBinOp Builtin
T      = Bool
False
isBinOp Builtin
Zip    = Bool
False
isBinOp Rank{} = Bool
False
isBinOp Builtin
Fib    = Bool
False
isBinOp Builtin
Log    = Bool
False
isBinOp Builtin
Size   = Bool
False
isBinOp Builtin
Sqrt   = Bool
False
isBinOp Scan{} = Bool
False
isBinOp Builtin
ItoF   = Bool
False
isBinOp Builtin
Last   = Bool
False
isBinOp Builtin
LastM  = Bool
False
isBinOp Builtin
Head   = Bool
False
isBinOp Builtin
HeadM  = Bool
False
isBinOp Builtin
Gen    = Bool
False
isBinOp TAt{}  = Bool
False
isBinOp Builtin
Outer  = Bool
False
isBinOp Builtin
R      = Bool
False
isBinOp Builtin
Tail   = Bool
False
isBinOp Builtin
TailM  = Bool
False
isBinOp Builtin
Init   = Bool
False
isBinOp Builtin
InitM  = Bool
False
isBinOp Builtin
Even   = Bool
False
isBinOp Builtin
Odd    = Bool
False
isBinOp Builtin
Abs    = Bool
False
isBinOp Builtin
Eye    = Bool
False
isBinOp Builtin
Flat   = Bool
False
isBinOp Builtin
AddDim = Bool
False
isBinOp Builtin
RevE   = Bool
False
isBinOp Builtin
C      = Bool
True
isBinOp Builtin
_      = Bool
True

fi :: Builtin -> Int
fi :: Builtin -> Int
fi Builtin
C = Int
9
fi Builtin
Succ = Int
9; fi Builtin
Fold = Int
9
fi Builtin
IntExp = Int
8; fi Builtin
Exp = Int
8
fi Builtin
Times = Int
7; fi Builtin
Div = Int
7; fi Builtin
Mod = Int
7
fi Builtin
Mul = Int
7; fi Builtin
VMul = Int
7
fi Builtin
Plus = Int
6; fi Builtin
Minus = Int
6
fi Builtin
And = Int
3; fi Builtin
Or = Int
2; fi Builtin
Xor = Int
6
fi Builtin
Ices = Int
6; fi Builtin
Filt=Int
6
fi Map{} = Int
5
fi Builtin
ConsE = Int
4; fi Builtin
Snoc = Int
4
fi Builtin
Eq = Int
4; fi Builtin
Neq = Int
4; fi Builtin
Gt = Int
4
fi Builtin
Lt = Int
4; fi Builtin
Lte = Int
4; fi Builtin
Gte = Int
4
fi Builtin
CatE = Int
5; fi Builtin
Sr=Int
8; fi Builtin
Sl=Int
8

lassoc :: Builtin -> Bool
lassoc :: Builtin -> Bool
lassoc Builtin
IntExp = Bool
False
lassoc Builtin
Exp    = Bool
False
lassoc Builtin
Div    = Bool
True
lassoc Builtin
Mod    = Bool
True
lassoc Builtin
Times  = Bool
True
lassoc Builtin
Mul    = Bool
True
lassoc Builtin
Plus   = Bool
True
lassoc Builtin
Minus  = Bool
True
lassoc Builtin
ConsE  = Bool
False
lassoc Map{}  = Bool
False
lassoc Builtin
CatE   = Bool
False
lassoc Builtin
Sr     = Bool
True
lassoc Builtin
Sl     = Bool
True
lassoc Builtin
Xor    = Bool
True
lassoc Builtin
Eq = Bool
False; lassoc Builtin
Neq = Bool
False
lassoc Builtin
Gte = Bool
False; lassoc Builtin
Lte = Bool
False
lassoc Builtin
Gt = Bool
False; lassoc Builtin
Lt = Bool
False

shuntl :: Builtin -> Builtin -> Bool
shuntl :: Builtin -> Builtin -> Bool
shuntl Builtin
op0 Builtin
op1 = Builtin -> Int
fi Builtin
op0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Builtin -> Int
fi Builtin
op1 Bool -> Bool -> Bool
|| Builtin -> Bool
lassoc Builtin
op0 Bool -> Bool -> Bool
&& Builtin -> Bool
lassoc Builtin
op1 Bool -> Bool -> Bool
&& Builtin -> Int
fi Builtin
op0 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Builtin -> Int
fi Builtin
op1

rw :: E a -> E a
rw :: forall a. E a -> E a
rw (EApp a
l0 (EApp a
l1 e0 :: E a
e0@(Builtin a
_ Builtin
op0) E a
e1) E a
e2) | Builtin -> Bool
isBinOp Builtin
op0 =
    case E a -> E a
forall a. E a -> E a
rw E a
e2 of
        (EApp a
l2 (EApp a
l3 e3 :: E a
e3@(Builtin a
_ Builtin
op1) E a
e4) E a
e5) | Builtin -> Bool
isBinOp Builtin
op1 Bool -> Bool -> Bool
&& Builtin -> Builtin -> Bool
shuntl Builtin
op0 Builtin
op1 -> a -> E a -> E a -> E a
forall a. a -> E a -> E a -> E a
EApp a
l0 (a -> E a -> E a -> E a
forall a. a -> E a -> E a -> E a
EApp a
l1 E a
e3 (E a -> E a
forall a. E a -> E a
rw (a -> E a -> E a -> E a
forall a. a -> E a -> E a -> E a
EApp a
l2 (a -> E a -> E a -> E a
forall a. a -> E a -> E a -> E a
EApp a
l3 E a
e0 E a
e1) E a
e4))) E a
e5
        E a
e2'                                                                          -> a -> E a -> E a -> E a
forall a. a -> E a -> E a -> E a
EApp a
l0 (a -> E a -> E a -> E a
forall a. a -> E a -> E a -> E a
EApp a
l1 E a
e0 (E a -> E a
forall a. E a -> E a
rw E a
e1)) E a
e2'
rw (EApp a
l E a
e0 E a
e') =
    case E a -> E a
forall a. E a -> E a
rw E a
e' of
        (EApp a
lϵ (EApp a
lϵϵ e3 :: E a
e3@(Builtin a
_ Builtin
op) E a
e4) E a
e2) | Builtin -> Bool
isBinOp Builtin
op -> a -> E a -> E a -> E a
forall a. a -> E a -> E a -> E a
EApp a
l (a -> E a -> E a -> E a
forall a. a -> E a -> E a -> E a
EApp a
lϵϵ E a
e3 (E a -> E a
forall a. E a -> E a
rw (E a -> E a) -> E a -> E a
forall a b. (a -> b) -> a -> b
$ a -> E a -> E a -> E a
forall a. a -> E a -> E a -> E a
EApp a
lϵ E a
e0 E a
e4)) E a
e2
        (Ann a
lϵ E a
e1 T a
t)                                             -> a -> E a -> T a -> E a
forall a. a -> E a -> T a -> E a
Ann a
lϵ (E a -> E a
forall a. E a -> E a
rw (E a -> E a) -> E a -> E a
forall a b. (a -> b) -> a -> b
$ a -> E a -> E a -> E a
forall a. a -> E a -> E a -> E a
EApp a
l E a
e0 E a
e1) T a
t
        (EApp a
lϵ e1 :: E a
e1@EApp{} E a
e2)                                    -> a -> E a -> E a -> E a
forall a. a -> E a -> E a -> E a
EApp a
l (E a -> E a
forall a. E a -> E a
rw (E a -> E a) -> E a -> E a
forall a b. (a -> b) -> a -> b
$ a -> E a -> E a -> E a
forall a. a -> E a -> E a -> E a
EApp a
lϵ E a
e0 E a
e1) E a
e2
        (EApp a
lϵ E a
e1 E a
e2)                                           -> a -> E a -> E a -> E a
forall a. a -> E a -> E a -> E a
EApp a
l (a -> E a -> E a -> E a
forall a. a -> E a -> E a -> E a
EApp a
lϵ (E a -> E a
forall a. E a -> E a
rw E a
e0) E a
e1) E a
e2
        E a
eRw                                                       -> a -> E a -> E a -> E a
forall a. a -> E a -> E a -> E a
EApp a
l (E a -> E a
forall a. E a -> E a
rw E a
e0) E a
eRw
rw (Let a
l (Nm a
n, E a
e') E a
e) = a -> (Nm a, E a) -> E a -> E a
forall a. a -> (Nm a, E a) -> E a -> E a
Let a
l (Nm a
n, E a -> E a
forall a. E a -> E a
rw E a
e') (E a -> E a
forall a. E a -> E a
rw E a
e)
rw (Def a
l (Nm a
n, E a
e') E a
e) = a -> (Nm a, E a) -> E a -> E a
forall a. a -> (Nm a, E a) -> E a -> E a
Def a
l (Nm a
n, E a -> E a
forall a. E a -> E a
rw E a
e') (E a -> E a
forall a. E a -> E a
rw E a
e)
rw (LLet a
l (Nm a
n, E a
e') E a
e) = a -> (Nm a, E a) -> E a -> E a
forall a. a -> (Nm a, E a) -> E a -> E a
LLet a
l (Nm a
n, E a -> E a
forall a. E a -> E a
rw E a
e') (E a -> E a
forall a. E a -> E a
rw E a
e)
rw (Tup a
l [E a]
es) = a -> [E a] -> E a
forall a. a -> [E a] -> E a
Tup a
l (E a -> E a
forall a. E a -> E a
rw(E a -> E a) -> [E a] -> [E a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[E a]
es)
rw (ALit a
l [E a]
es) = a -> [E a] -> E a
forall a. a -> [E a] -> E a
ALit a
l (E a -> E a
forall a. E a -> E a
rw(E a -> E a) -> [E a] -> [E a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>[E a]
es)
rw (Lam a
l Nm a
n E a
e) = a -> Nm a -> E a -> E a
forall a. a -> Nm a -> E a -> E a
Lam a
l Nm a
n (E a -> E a
forall a. E a -> E a
rw E a
e)
rw (Dfn a
l E a
e) = a -> E a -> E a
forall a. a -> E a -> E a
Dfn a
l (E a -> E a
forall a. E a -> E a
rw E a
e)
rw (Parens a
l E a
e) = a -> E a -> E a
forall a. a -> E a -> E a
Parens a
l (E a -> E a
forall a. E a -> E a
rw E a
e)
rw (Ann a
l E a
e T a
t) = a -> E a -> T a -> E a
forall a. a -> E a -> T a -> E a
Ann a
l (E a -> E a
forall a. E a -> E a
rw E a
e) (T a -> T a
forall a. T a -> T a
rt T a
t)
rw (Cond a
l E a
p E a
e E a
e') = a -> E a -> E a -> E a -> E a
forall a. a -> E a -> E a -> E a -> E a
Cond a
l (E a -> E a
forall a. E a -> E a
rw E a
p) (E a -> E a
forall a. E a -> E a
rw E a
e) (E a -> E a
forall a. E a -> E a
rw E a
e')
rw E a
e = E a
e

rt :: T a -> T a
rt :: forall a. T a -> T a
rt (Arr Sh a
sh (Arrow T a
t T a
t')) = T a -> T a -> T a
forall a. T a -> T a -> T a
Arrow (Sh a -> T a -> T a
forall a. Sh a -> T a -> T a
Arr Sh a
sh (T a -> T a
forall a. T a -> T a
rt T a
t)) (T a -> T a
forall a. T a -> T a
rt T a
t')
rt T a
t                     = T a
t