{-# LANGUAGE CPP #-}
module GHC.TypeLits.Normalise.SOP
(
Symbol (..)
, Product (..)
, SOP (..)
, reduceExp
, mergeS
, mergeP
, mergeSOPAdd
, mergeSOPMul
, normaliseExp
, simplifySOP
)
where
import Data.Either (partitionEithers)
import Data.List (sort)
#if MIN_VERSION_ghc(9,0,0)
import GHC.Utils.Outputable (Outputable (..), (<+>), text, hcat, integer, punctuate)
#else
import Outputable (Outputable (..), (<+>), text, hcat, integer, punctuate)
#endif
data Symbol v c
= I Integer
| C c
| E (SOP v c) (Product v c)
| V v
deriving (Symbol v c -> Symbol v c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v c. (Eq c, Eq v) => Symbol v c -> Symbol v c -> Bool
/= :: Symbol v c -> Symbol v c -> Bool
$c/= :: forall v c. (Eq c, Eq v) => Symbol v c -> Symbol v c -> Bool
== :: Symbol v c -> Symbol v c -> Bool
$c== :: forall v c. (Eq c, Eq v) => Symbol v c -> Symbol v c -> Bool
Eq,Symbol v c -> Symbol v c -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {v} {c}. (Ord c, Ord v) => Eq (Symbol v c)
forall v c. (Ord c, Ord v) => Symbol v c -> Symbol v c -> Bool
forall v c. (Ord c, Ord v) => Symbol v c -> Symbol v c -> Ordering
forall v c.
(Ord c, Ord v) =>
Symbol v c -> Symbol v c -> Symbol v c
min :: Symbol v c -> Symbol v c -> Symbol v c
$cmin :: forall v c.
(Ord c, Ord v) =>
Symbol v c -> Symbol v c -> Symbol v c
max :: Symbol v c -> Symbol v c -> Symbol v c
$cmax :: forall v c.
(Ord c, Ord v) =>
Symbol v c -> Symbol v c -> Symbol v c
>= :: Symbol v c -> Symbol v c -> Bool
$c>= :: forall v c. (Ord c, Ord v) => Symbol v c -> Symbol v c -> Bool
> :: Symbol v c -> Symbol v c -> Bool
$c> :: forall v c. (Ord c, Ord v) => Symbol v c -> Symbol v c -> Bool
<= :: Symbol v c -> Symbol v c -> Bool
$c<= :: forall v c. (Ord c, Ord v) => Symbol v c -> Symbol v c -> Bool
< :: Symbol v c -> Symbol v c -> Bool
$c< :: forall v c. (Ord c, Ord v) => Symbol v c -> Symbol v c -> Bool
compare :: Symbol v c -> Symbol v c -> Ordering
$ccompare :: forall v c. (Ord c, Ord v) => Symbol v c -> Symbol v c -> Ordering
Ord)
newtype Product v c = P { forall v c. Product v c -> [Symbol v c]
unP :: [Symbol v c] }
deriving (Product v c -> Product v c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall v c. (Eq c, Eq v) => Product v c -> Product v c -> Bool
/= :: Product v c -> Product v c -> Bool
$c/= :: forall v c. (Eq c, Eq v) => Product v c -> Product v c -> Bool
== :: Product v c -> Product v c -> Bool
$c== :: forall v c. (Eq c, Eq v) => Product v c -> Product v c -> Bool
Eq)
instance (Ord v, Ord c) => Ord (Product v c) where
compare :: Product v c -> Product v c -> Ordering
compare (P [Symbol v c
x]) (P [Symbol v c
y]) = forall a. Ord a => a -> a -> Ordering
compare Symbol v c
x Symbol v c
y
compare (P [Symbol v c
_]) (P (Symbol v c
_:[Symbol v c]
_)) = Ordering
LT
compare (P (Symbol v c
_:[Symbol v c]
_)) (P [Symbol v c
_]) = Ordering
GT
compare (P [Symbol v c]
xs) (P [Symbol v c]
ys) = forall a. Ord a => a -> a -> Ordering
compare [Symbol v c]
xs [Symbol v c]
ys
newtype SOP v c = S { forall v c. SOP v c -> [Product v c]
unS :: [Product v c] }
deriving (SOP v c -> SOP v c -> Bool
SOP v c -> SOP v c -> Ordering
SOP v c -> SOP v c -> SOP v c
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {v} {c}. (Ord v, Ord c) => Eq (SOP v c)
forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> Bool
forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> Ordering
forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> SOP v c
min :: SOP v c -> SOP v c -> SOP v c
$cmin :: forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> SOP v c
max :: SOP v c -> SOP v c -> SOP v c
$cmax :: forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> SOP v c
>= :: SOP v c -> SOP v c -> Bool
$c>= :: forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> Bool
> :: SOP v c -> SOP v c -> Bool
$c> :: forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> Bool
<= :: SOP v c -> SOP v c -> Bool
$c<= :: forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> Bool
< :: SOP v c -> SOP v c -> Bool
$c< :: forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> Bool
compare :: SOP v c -> SOP v c -> Ordering
$ccompare :: forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> Ordering
Ord)
instance (Eq v, Eq c) => Eq (SOP v c) where
(S []) == :: SOP v c -> SOP v c -> Bool
== (S [P [I Integer
0]]) = Bool
True
(S [P [I Integer
0]]) == (S []) = Bool
True
(S [Product v c]
ps1) == (S [Product v c]
ps2) = [Product v c]
ps1 forall a. Eq a => a -> a -> Bool
== [Product v c]
ps2
instance (Outputable v, Outputable c) => Outputable (SOP v c) where
ppr :: SOP v c -> SDoc
ppr = [SDoc] -> SDoc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> [SDoc] -> [SDoc]
punctuate (String -> SDoc
text String
" + ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c. SOP v c -> [Product v c]
unS
instance (Outputable v, Outputable c) => Outputable (Product v c) where
ppr :: Product v c -> SDoc
ppr = [SDoc] -> SDoc
hcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> [SDoc] -> [SDoc]
punctuate (String -> SDoc
text String
" * ") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Outputable a => a -> SDoc
ppr forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c. Product v c -> [Symbol v c]
unP
instance (Outputable v, Outputable c) => Outputable (Symbol v c) where
ppr :: Symbol v c -> SDoc
ppr (I Integer
i) = Integer -> SDoc
integer Integer
i
ppr (C c
c) = forall a. Outputable a => a -> SDoc
ppr c
c
ppr (V v
s) = forall a. Outputable a => a -> SDoc
ppr v
s
ppr (E SOP v c
b Product v c
e) = case (forall v c. (Outputable v, Outputable c) => SOP v c -> SDoc
pprSimple SOP v c
b, forall v c. (Outputable v, Outputable c) => SOP v c -> SDoc
pprSimple (forall v c. [Product v c] -> SOP v c
S [Product v c
e])) of
(SDoc
bS,SDoc
eS) -> SDoc
bS SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"^" SDoc -> SDoc -> SDoc
<+> SDoc
eS
where
pprSimple :: SOP a c -> SDoc
pprSimple (S [P [I Integer
i]]) = Integer -> SDoc
integer Integer
i
pprSimple (S [P [V a
v]]) = forall a. Outputable a => a -> SDoc
ppr a
v
pprSimple SOP a c
sop = String -> SDoc
text String
"(" SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr SOP a c
sop SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
")"
mergeWith :: (a -> a -> Either a a) -> [a] -> [a]
mergeWith :: forall a. (a -> a -> Either a a) -> [a] -> [a]
mergeWith a -> a -> Either a a
_ [] = []
mergeWith a -> a -> Either a a
op (a
f:[a]
fs) = case forall a b. [Either a b] -> ([a], [b])
partitionEithers forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (a -> a -> Either a a
`op` a
f) [a]
fs of
([],[a]
_) -> a
f forall a. a -> [a] -> [a]
: forall a. (a -> a -> Either a a) -> [a] -> [a]
mergeWith a -> a -> Either a a
op [a]
fs
([a]
updated,[a]
untouched) -> forall a. (a -> a -> Either a a) -> [a] -> [a]
mergeWith a -> a -> Either a a
op ([a]
updated forall a. [a] -> [a] -> [a]
++ [a]
untouched)
reduceExp :: (Ord v, Ord c) => Symbol v c -> Symbol v c
reduceExp :: forall v c. (Ord v, Ord c) => Symbol v c -> Symbol v c
reduceExp (E SOP v c
_ (P [(I Integer
0)])) = forall v c. Integer -> Symbol v c
I Integer
1
reduceExp (E (S [P [I Integer
0]]) Product v c
_ ) = forall v c. Integer -> Symbol v c
I Integer
0
reduceExp (E (S [P [(I Integer
i)]]) (P [(I Integer
j)]))
| Integer
j forall a. Ord a => a -> a -> Bool
>= Integer
0 = forall v c. Integer -> Symbol v c
I (Integer
i forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
j)
reduceExp (E (S [P [(E SOP v c
k Product v c
i)]]) Product v c
j) = case forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> SOP v c
normaliseExp SOP v c
k (forall v c. [Product v c] -> SOP v c
S [Product v c
e]) of
(S [P [Symbol v c
s]]) -> Symbol v c
s
SOP v c
_ -> forall v c. SOP v c -> Product v c -> Symbol v c
E SOP v c
k Product v c
e
where
e :: Product v c
e = forall v c. [Symbol v c] -> Product v c
P forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall v c. (Ord v, Ord c) => Symbol v c -> Symbol v c
reduceExp forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Either a a) -> [a] -> [a]
mergeWith forall v c.
(Ord v, Ord c) =>
Symbol v c -> Symbol v c -> Either (Symbol v c) (Symbol v c)
mergeS (forall v c. Product v c -> [Symbol v c]
unP Product v c
i forall a. [a] -> [a] -> [a]
++ forall v c. Product v c -> [Symbol v c]
unP Product v c
j)
reduceExp Symbol v c
s = Symbol v c
s
mergeS :: (Ord v, Ord c) => Symbol v c -> Symbol v c
-> Either (Symbol v c) (Symbol v c)
mergeS :: forall v c.
(Ord v, Ord c) =>
Symbol v c -> Symbol v c -> Either (Symbol v c) (Symbol v c)
mergeS (I Integer
i) (I Integer
j) = forall a b. a -> Either a b
Left (forall v c. Integer -> Symbol v c
I (Integer
i forall a. Num a => a -> a -> a
* Integer
j))
mergeS (I Integer
1) Symbol v c
r = forall a b. a -> Either a b
Left Symbol v c
r
mergeS Symbol v c
l (I Integer
1) = forall a b. a -> Either a b
Left Symbol v c
l
mergeS (I Integer
0) Symbol v c
_ = forall a b. a -> Either a b
Left (forall v c. Integer -> Symbol v c
I Integer
0)
mergeS Symbol v c
_ (I Integer
0) = forall a b. a -> Either a b
Left (forall v c. Integer -> Symbol v c
I Integer
0)
mergeS Symbol v c
s (E (S [P [Symbol v c
s']]) (P [I Integer
i]))
| Symbol v c
s forall a. Eq a => a -> a -> Bool
== Symbol v c
s'
= forall a b. a -> Either a b
Left (forall v c. SOP v c -> Product v c -> Symbol v c
E (forall v c. [Product v c] -> SOP v c
S [forall v c. [Symbol v c] -> Product v c
P [Symbol v c
s']]) (forall v c. [Symbol v c] -> Product v c
P [forall v c. Integer -> Symbol v c
I (Integer
i forall a. Num a => a -> a -> a
+ Integer
1)]))
mergeS (E (S [P [Symbol v c
s']]) (P [I Integer
i])) Symbol v c
s
| Symbol v c
s forall a. Eq a => a -> a -> Bool
== Symbol v c
s'
= forall a b. a -> Either a b
Left (forall v c. SOP v c -> Product v c -> Symbol v c
E (forall v c. [Product v c] -> SOP v c
S [forall v c. [Symbol v c] -> Product v c
P [Symbol v c
s']]) (forall v c. [Symbol v c] -> Product v c
P [forall v c. Integer -> Symbol v c
I (Integer
i forall a. Num a => a -> a -> a
+ Integer
1)]))
mergeS (E (S [P [I Integer
i]]) Product v c
p) (E (S [P [I Integer
j]]) Product v c
p')
| Product v c
p forall a. Eq a => a -> a -> Bool
== Product v c
p'
= forall a b. a -> Either a b
Left (forall v c. SOP v c -> Product v c -> Symbol v c
E (forall v c. [Product v c] -> SOP v c
S [forall v c. [Symbol v c] -> Product v c
P [forall v c. Integer -> Symbol v c
I (Integer
iforall a. Num a => a -> a -> a
*Integer
j)]]) Product v c
p)
mergeS Symbol v c
l Symbol v c
r
| Symbol v c
l forall a. Eq a => a -> a -> Bool
== Symbol v c
r
= case forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> SOP v c
normaliseExp (forall v c. [Product v c] -> SOP v c
S [forall v c. [Symbol v c] -> Product v c
P [Symbol v c
l]]) (forall v c. [Product v c] -> SOP v c
S [forall v c. [Symbol v c] -> Product v c
P [forall v c. Integer -> Symbol v c
I Integer
2]]) of
(S [P [Symbol v c
e]]) -> forall a b. a -> Either a b
Left Symbol v c
e
SOP v c
_ -> forall a b. b -> Either a b
Right Symbol v c
l
mergeS (E SOP v c
s1 (P [Symbol v c]
p1)) (E SOP v c
s2 (P (I Integer
i:[Symbol v c]
p2)))
| Integer
i forall a. Eq a => a -> a -> Bool
== (-Integer
1)
, SOP v c
s1 forall a. Eq a => a -> a -> Bool
== SOP v c
s2
, [Symbol v c]
p1 forall a. Eq a => a -> a -> Bool
== [Symbol v c]
p2
= forall a b. a -> Either a b
Left (forall v c. Integer -> Symbol v c
I Integer
1)
mergeS (E SOP v c
s1 (P (I Integer
i:[Symbol v c]
p1))) (E SOP v c
s2 (P [Symbol v c]
p2))
| Integer
i forall a. Eq a => a -> a -> Bool
== (-Integer
1)
, SOP v c
s1 forall a. Eq a => a -> a -> Bool
== SOP v c
s2
, [Symbol v c]
p1 forall a. Eq a => a -> a -> Bool
== [Symbol v c]
p2
= forall a b. a -> Either a b
Left (forall v c. Integer -> Symbol v c
I Integer
1)
mergeS Symbol v c
l Symbol v c
_ = forall a b. b -> Either a b
Right Symbol v c
l
mergeP :: (Eq v, Eq c) => Product v c -> Product v c
-> Either (Product v c) (Product v c)
mergeP :: forall v c.
(Eq v, Eq c) =>
Product v c -> Product v c -> Either (Product v c) (Product v c)
mergeP (P ((I Integer
i):[Symbol v c]
is)) (P ((I Integer
j):[Symbol v c]
js))
| [Symbol v c]
is forall a. Eq a => a -> a -> Bool
== [Symbol v c]
js = forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c. [Symbol v c] -> Product v c
P forall a b. (a -> b) -> a -> b
$ (forall v c. Integer -> Symbol v c
I (Integer
i forall a. Num a => a -> a -> a
+ Integer
j)) forall a. a -> [a] -> [a]
: [Symbol v c]
is
mergeP (P ((I Integer
i):[Symbol v c]
is)) (P [Symbol v c]
js)
| [Symbol v c]
is forall a. Eq a => a -> a -> Bool
== [Symbol v c]
js = forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c. [Symbol v c] -> Product v c
P forall a b. (a -> b) -> a -> b
$ (forall v c. Integer -> Symbol v c
I (Integer
i forall a. Num a => a -> a -> a
+ Integer
1)) forall a. a -> [a] -> [a]
: [Symbol v c]
is
mergeP (P [Symbol v c]
is) (P ((I Integer
j):[Symbol v c]
js))
| [Symbol v c]
is forall a. Eq a => a -> a -> Bool
== [Symbol v c]
js = forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c. [Symbol v c] -> Product v c
P forall a b. (a -> b) -> a -> b
$ (forall v c. Integer -> Symbol v c
I (Integer
j forall a. Num a => a -> a -> a
+ Integer
1)) forall a. a -> [a] -> [a]
: [Symbol v c]
is
mergeP (P [Symbol v c]
is) (P [Symbol v c]
js)
| [Symbol v c]
is forall a. Eq a => a -> a -> Bool
== [Symbol v c]
js = forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c. [Symbol v c] -> Product v c
P forall a b. (a -> b) -> a -> b
$ (forall v c. Integer -> Symbol v c
I Integer
2) forall a. a -> [a] -> [a]
: [Symbol v c]
is
| Bool
otherwise = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ forall v c. [Symbol v c] -> Product v c
P [Symbol v c]
is
normaliseExp :: (Ord v, Ord c) => SOP v c -> SOP v c -> SOP v c
normaliseExp :: forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> SOP v c
normaliseExp SOP v c
b (S [P [I Integer
1]]) = SOP v c
b
normaliseExp b :: SOP v c
b@(S [P [V v
_]]) (S [Product v c
e]) = forall v c. [Product v c] -> SOP v c
S [forall v c. [Symbol v c] -> Product v c
P [forall v c. SOP v c -> Product v c -> Symbol v c
E SOP v c
b Product v c
e]]
normaliseExp b :: SOP v c
b@(S [P [Symbol v c
_]]) (S [e :: Product v c
e@(P [Symbol v c
_])]) = forall v c. [Product v c] -> SOP v c
S [forall v c. [Symbol v c] -> Product v c
P [forall v c. (Ord v, Ord c) => Symbol v c -> Symbol v c
reduceExp (forall v c. SOP v c -> Product v c -> Symbol v c
E SOP v c
b Product v c
e)]]
normaliseExp SOP v c
b (S [P [(I Integer
i)]]) | Integer
i forall a. Ord a => a -> a -> Bool
> Integer
0 =
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> SOP v c
mergeSOPMul (forall a. Int -> a -> [a]
replicate (forall a. Num a => Integer -> a
fromInteger Integer
i) SOP v c
b)
normaliseExp SOP v c
b (S [P (e :: Symbol v c
e@(I Integer
i):[Symbol v c]
es)]) | Integer
i forall a. Ord a => a -> a -> Bool
>= Integer
0 =
forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> SOP v c
normaliseExp (forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> SOP v c
normaliseExp SOP v c
b (forall v c. [Product v c] -> SOP v c
S [forall v c. [Symbol v c] -> Product v c
P [Symbol v c
e]])) (forall v c. [Product v c] -> SOP v c
S [forall v c. [Symbol v c] -> Product v c
P [Symbol v c]
es])
normaliseExp SOP v c
b (S [Product v c
e]) = forall v c. [Product v c] -> SOP v c
S [forall v c. [Symbol v c] -> Product v c
P [forall v c. (Ord v, Ord c) => Symbol v c -> Symbol v c
reduceExp (forall v c. SOP v c -> Product v c -> Symbol v c
E SOP v c
b Product v c
e)]]
normaliseExp SOP v c
b (S [Product v c]
e) = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> SOP v c
mergeSOPMul (forall a b. (a -> b) -> [a] -> [b]
map (forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> SOP v c
normaliseExp SOP v c
b forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c. [Product v c] -> SOP v c
S forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[])) [Product v c]
e)
zeroP :: Product v c -> Bool
zeroP :: forall v c. Product v c -> Bool
zeroP (P ((I Integer
0):[Symbol v c]
_)) = Bool
True
zeroP Product v c
_ = Bool
False
mkNonEmpty :: SOP v c -> SOP v c
mkNonEmpty :: forall v c. SOP v c -> SOP v c
mkNonEmpty (S []) = forall v c. [Product v c] -> SOP v c
S [forall v c. [Symbol v c] -> Product v c
P [(forall v c. Integer -> Symbol v c
I Integer
0)]]
mkNonEmpty SOP v c
s = SOP v c
s
simplifySOP :: (Ord v, Ord c) => SOP v c -> SOP v c
simplifySOP :: forall v c. (Ord v, Ord c) => SOP v c -> SOP v c
simplifySOP = forall {t}. Eq t => (t -> t) -> t -> t
repeatF SOP v c -> SOP v c
go
where
go :: SOP v c -> SOP v c
go = forall v c. SOP v c -> SOP v c
mkNonEmpty
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c. [Product v c] -> SOP v c
S
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c. Product v c -> Bool
zeroP)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Either a a) -> [a] -> [a]
mergeWith forall v c.
(Eq v, Eq c) =>
Product v c -> Product v c -> Either (Product v c) (Product v c)
mergeP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall v c. [Symbol v c] -> Product v c
P forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> [a]
sort forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall v c. (Ord v, Ord c) => Symbol v c -> Symbol v c
reduceExp forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Either a a) -> [a] -> [a]
mergeWith forall v c.
(Ord v, Ord c) =>
Symbol v c -> Symbol v c -> Either (Symbol v c) (Symbol v c)
mergeS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c. Product v c -> [Symbol v c]
unP)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c. SOP v c -> [Product v c]
unS
repeatF :: (t -> t) -> t -> t
repeatF t -> t
f t
x =
let x' :: t
x' = t -> t
f t
x
in if t
x' forall a. Eq a => a -> a -> Bool
== t
x
then t
x
else (t -> t) -> t -> t
repeatF t -> t
f t
x'
{-# INLINEABLE simplifySOP #-}
mergeSOPAdd :: (Ord v, Ord c) => SOP v c -> SOP v c -> SOP v c
mergeSOPAdd :: forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> SOP v c
mergeSOPAdd (S [Product v c]
sop1) (S [Product v c]
sop2) = forall v c. (Ord v, Ord c) => SOP v c -> SOP v c
simplifySOP forall a b. (a -> b) -> a -> b
$ forall v c. [Product v c] -> SOP v c
S ([Product v c]
sop1 forall a. [a] -> [a] -> [a]
++ [Product v c]
sop2)
{-# INLINEABLE mergeSOPAdd #-}
mergeSOPMul :: (Ord v, Ord c) => SOP v c -> SOP v c -> SOP v c
mergeSOPMul :: forall v c. (Ord v, Ord c) => SOP v c -> SOP v c -> SOP v c
mergeSOPMul (S [Product v c]
sop1) (S [Product v c]
sop2)
= forall v c. (Ord v, Ord c) => SOP v c -> SOP v c
simplifySOP
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v c. [Product v c] -> SOP v c
S
forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Product v c
p1 Product v c
p2 -> forall v c. [Symbol v c] -> Product v c
P (forall v c. Product v c -> [Symbol v c]
unP Product v c
p1 forall a. [a] -> [a] -> [a]
++ forall v c. Product v c -> [Symbol v c]
unP Product v c
p2)) [Product v c]
sop1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a]
repeat) [Product v c]
sop2
{-# INLINEABLE mergeSOPMul #-}