-- | The abstract motivic algorithm
--
-- See: B. Komuves: Motivic characteristic classes of discriminant strata
--
-- TODO: caching of results (otherwise it is very slow)

{-# LANGUAGE CPP, BangPatterns, FlexibleInstances, TypeSynonymInstances,
             MultiParamTypeClasses, FunctionalDependencies, GeneralizedNewtypeDeriving,
             TypeFamilies
  #-}
module Math.RootLoci.Motivic.Abstract where

--------------------------------------------------------------------------------

import Data.Char
import Data.List
import Data.Ord
import Data.Maybe

import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map

import qualified Math.Algebra.Polynomial.FreeModule as ZMod 
import Math.Algebra.Polynomial.FreeModule (ZMod,QMod,FreeMod)
import Math.Algebra.Polynomial.Pretty

import Math.Combinat.Classes hiding (empty)
import Math.Combinat.Tuples
import Math.Combinat.Partitions
import Math.Combinat.Permutations hiding (permute)

-- import Debug.Trace
-- debug s x y = trace (">>> " ++ s ++ " -> " ++ show x) y

import Math.RootLoci.Motivic.Classes
import Math.RootLoci.Misc.Common

--------------------------------------------------------------------------------
-- * The abstract algorithm

-- | The (abstract) class of @Sym^n(X)@
symn :: Num c => Dim -> FreeMod c SingleLam
symn :: Dim -> FreeMod c SingleLam
symn Dim
dim = SingleLam -> FreeMod c SingleLam
forall c b. Num c => b -> FreeMod c b
ZMod.generator (SingleLam -> FreeMod c SingleLam)
-> SingleLam -> FreeMod c SingleLam
forall a b. (a -> b) -> a -> b
$ Bindings -> Single -> SingleLam
SingleLam ([Dim] -> Bindings
Bindings [Dim
dim]) ([(Var, Int)] -> Single
Single [(Int -> Var
DeBruijn Int
0, Int
1)])

-- | The open stratum X(1,1,...,1)
open :: Dim -> ZMod SingleLam
open :: Dim -> ZMod SingleLam
open d :: Dim
d@(Dim Int
n) = Dim -> ZMod SingleLam
forall c. Num c => Dim -> FreeMod c SingleLam
symn Dim
d ZMod SingleLam -> ZMod SingleLam -> ZMod SingleLam
forall b c.
(Ord b, Eq c, Num c) =>
FreeMod c b -> FreeMod c b -> FreeMod c b
`ZMod.sub` ZMod SingleLam
rest where
  rest :: ZMod SingleLam
rest = [ZMod SingleLam] -> ZMod SingleLam
forall b c. (Ord b, Eq c, Num c) => [FreeMod c b] -> FreeMod c b
ZMod.sum [ Partition -> ZMod SingleLam
xlam Partition
p | Partition
p <- Int -> [Partition]
partitions Int
n , Partition -> Int
forall a. HasWidth a => a -> Int
width Partition
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n ]

zeros :: Int -> ZMod MultiLam
zeros :: Int -> ZMod MultiLam
zeros Int
k = MultiLam -> ZMod MultiLam
forall c b. Num c => b -> FreeMod c b
ZMod.generator 
        (MultiLam -> ZMod MultiLam) -> MultiLam -> ZMod MultiLam
forall a b. (a -> b) -> a -> b
$ Bindings -> Multi -> MultiLam
MultiLam ([Dim] -> Bindings
Bindings []) ([Single] -> Multi
Multi ([Single] -> Multi) -> [Single] -> Multi
forall a b. (a -> b) -> a -> b
$ Int -> Single -> [Single]
forall a. Int -> a -> [a]
replicate Int
k ([(Var, Int)] -> Single
Single []))

-- | The open stratum X(lambda)
xlam :: Partition -> ZMod SingleLam
xlam :: Partition -> ZMod SingleLam
xlam Partition
p = 
  if Partition -> Int
forall a. HasHeight a => a -> Int
height Partition
p Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1   
    then Dim -> ZMod SingleLam
open (Int -> Dim
Dim (Int -> Dim) -> Int -> Dim
forall a b. (a -> b) -> a -> b
$ Partition -> Int
forall a. HasWeight a => a -> Int
weight Partition
p)
    else ZMod SingleLam -> ZMod SingleLam
forall a. Normalize a => a -> a
normalize (ZMod SingleLam -> ZMod SingleLam)
-> ZMod SingleLam -> ZMod SingleLam
forall a b. (a -> b) -> a -> b
$ ZMod MultiLam -> ZMod SingleLam
forall t s. Psi t s => t -> s
psi (ZMod MultiLam -> ZMod SingleLam)
-> ZMod MultiLam -> ZMod SingleLam
forall a b. (a -> b) -> a -> b
$ ZMod MultiLam -> ZMod MultiLam
forall a. Omega123 a => a -> a
omega123 (ZMod MultiLam -> ZMod MultiLam) -> ZMod MultiLam -> ZMod MultiLam
forall a b. (a -> b) -> a -> b
$ [Dim] -> ZMod MultiLam
dvec ([Dim] -> ZMod MultiLam) -> [Dim] -> ZMod MultiLam
forall a b. (a -> b) -> a -> b
$ Partition -> [Dim]
dimVector Partition
p

-- | The open stratum D(n1,n2,...)
dvec :: [Dim] -> ZMod MultiLam
dvec :: [Dim] -> ZMod MultiLam
dvec [Dim]
dims0 = Permutation -> ZMod MultiLam -> ZMod MultiLam
forall a. Permute a => Permutation -> a -> a
permute Permutation
invperm ZMod MultiLam
sorted where
  invperm :: Permutation
invperm = Permutation -> Permutation
inversePermutation Permutation
perm
  perm :: Permutation
perm    = [Dim] -> Permutation
forall a. Ord a => [a] -> Permutation
sortingPermutationDesc [Dim]
dims0
  dims1 :: [Dim]
dims1   = Permutation -> [Dim] -> [Dim]
forall a. Permutation -> [a] -> [a]
permuteList Permutation
perm [Dim]
dims0
  ([Dim]
dims2,[Dim]
dzeros) = (Dim -> Bool) -> [Dim] -> ([Dim], [Dim])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Dim -> Dim -> Bool
forall a. Ord a => a -> a -> Bool
>Dim
0) [Dim]
dims1        -- separate zero dimensions
  sorted :: ZMod MultiLam
sorted  = ZMod MultiLam -> ZMod MultiLam -> ZMod MultiLam
forall a. Cross a => a -> a -> a
cross ([Dim] -> ZMod MultiLam
dvecSorted [Dim]
dims2) (Int -> ZMod MultiLam
zeros (Int -> ZMod MultiLam) -> Int -> ZMod MultiLam
forall a b. (a -> b) -> a -> b
$ [Dim] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Dim]
dzeros)

-- | The open stratum D(n1,n2,...), assuming @n1 >= n2 >= n3 >= ...@
dvecSorted :: [Dim] -> ZMod MultiLam
dvecSorted :: [Dim] -> ZMod MultiLam
dvecSorted []     = [Char] -> ZMod MultiLam
forall a. HasCallStack => [Char] -> a
error [Char]
"dvec: empty dimension vector shouldn't appear in the algorithm"
dvecSorted [Dim
n]    = ZMod SingleLam -> ZMod MultiLam
forall s t. SingleToMulti s t => s -> t
singleToMulti (Dim -> ZMod SingleLam
open Dim
n)
dvecSorted (Dim
p:[Dim]
ns) = ZMod MultiLam -> ZMod MultiLam
forall a. Normalize a => a -> a
normalize (ZMod MultiLam -> ZMod MultiLam -> ZMod MultiLam
forall b c.
(Ord b, Eq c, Num c) =>
FreeMod c b -> FreeMod c b -> FreeMod c b
ZMod.sub ZMod MultiLam
big ZMod MultiLam
rest) where
  big :: ZMod MultiLam
big  = ZMod MultiLam -> ZMod MultiLam -> ZMod MultiLam
forall a. Cross a => a -> a -> a
cross (ZMod SingleLam -> ZMod MultiLam
forall s t. SingleToMulti s t => s -> t
singleToMulti (ZMod SingleLam -> ZMod MultiLam)
-> ZMod SingleLam -> ZMod MultiLam
forall a b. (a -> b) -> a -> b
$ Dim -> ZMod SingleLam
open Dim
p) ([Dim] -> ZMod MultiLam
dvecSorted [Dim]
ns)
  rest :: ZMod MultiLam
rest = [ZMod MultiLam] -> ZMod MultiLam
forall b c. (Ord b, Eq c, Num c) => [FreeMod c b] -> FreeMod c b
ZMod.sum  
    [ ZMod MultiLam -> ZMod MultiLam
forall a. Theta a => a -> a
theta ([Dim] -> ZMod MultiLam
dvec (Dim
k Dim -> [Dim] -> [Dim]
forall a. a -> [a] -> [a]
: [Dim] -> [Dim] -> [Dim]
forall a. [a] -> [a] -> [a]
interleave [Dim]
ds [Dim]
es))
    | [Dim]
ds <- [Dim] -> [[Dim]]
dimTuples [Dim]
ns
    , let es :: [Dim]
es = (Dim -> Dim -> Dim) -> [Dim] -> [Dim] -> [Dim]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) [Dim]
ns [Dim]
ds
    , let l :: Dim
l = [Dim] -> Dim
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [Dim]
es
    , Dim
l Dim -> Dim -> Bool
forall a. Ord a => a -> a -> Bool
> Dim
0 
    , let k :: Dim
k = Dim
p Dim -> Dim -> Dim
forall a. Num a => a -> a -> a
- Dim
l
    , Dim
k Dim -> Dim -> Bool
forall a. Ord a => a -> a -> Bool
>= Dim
0
    ] 

--------------------------------------------------------------------------------
-- * Data types and instances

-- | A variable, implemented as a /de Bruijn level/ (indexing starts from 0)
newtype Var 
  = DeBruijn Int      
  deriving (Var -> Var -> Bool
(Var -> Var -> Bool) -> (Var -> Var -> Bool) -> Eq Var
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Var -> Var -> Bool
$c/= :: Var -> Var -> Bool
== :: Var -> Var -> Bool
$c== :: Var -> Var -> Bool
Eq,Eq Var
Eq Var
-> (Var -> Var -> Ordering)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Bool)
-> (Var -> Var -> Var)
-> (Var -> Var -> Var)
-> Ord Var
Var -> Var -> Bool
Var -> Var -> Ordering
Var -> Var -> Var
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
min :: Var -> Var -> Var
$cmin :: Var -> Var -> Var
max :: Var -> Var -> Var
$cmax :: Var -> Var -> Var
>= :: Var -> Var -> Bool
$c>= :: Var -> Var -> Bool
> :: Var -> Var -> Bool
$c> :: Var -> Var -> Bool
<= :: Var -> Var -> Bool
$c<= :: Var -> Var -> Bool
< :: Var -> Var -> Bool
$c< :: Var -> Var -> Bool
compare :: Var -> Var -> Ordering
$ccompare :: Var -> Var -> Ordering
$cp1Ord :: Eq Var
Ord,Int -> Var -> ShowS
[Var] -> ShowS
Var -> [Char]
(Int -> Var -> ShowS)
-> (Var -> [Char]) -> ([Var] -> ShowS) -> Show Var
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Var] -> ShowS
$cshowList :: [Var] -> ShowS
show :: Var -> [Char]
$cshow :: Var -> [Char]
showsPrec :: Int -> Var -> ShowS
$cshowsPrec :: Int -> Var -> ShowS
Show)

--------------------------------------------------------------------------------

-- | We use de Bruijn levels to index the bound variables, and ecah bound variables has a dimension
newtype Bindings 
  = Bindings [Dim]
  deriving (Bindings -> Bindings -> Bool
(Bindings -> Bindings -> Bool)
-> (Bindings -> Bindings -> Bool) -> Eq Bindings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bindings -> Bindings -> Bool
$c/= :: Bindings -> Bindings -> Bool
== :: Bindings -> Bindings -> Bool
$c== :: Bindings -> Bindings -> Bool
Eq,Eq Bindings
Eq Bindings
-> (Bindings -> Bindings -> Ordering)
-> (Bindings -> Bindings -> Bool)
-> (Bindings -> Bindings -> Bool)
-> (Bindings -> Bindings -> Bool)
-> (Bindings -> Bindings -> Bool)
-> (Bindings -> Bindings -> Bindings)
-> (Bindings -> Bindings -> Bindings)
-> Ord Bindings
Bindings -> Bindings -> Bool
Bindings -> Bindings -> Ordering
Bindings -> Bindings -> Bindings
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
min :: Bindings -> Bindings -> Bindings
$cmin :: Bindings -> Bindings -> Bindings
max :: Bindings -> Bindings -> Bindings
$cmax :: Bindings -> Bindings -> Bindings
>= :: Bindings -> Bindings -> Bool
$c>= :: Bindings -> Bindings -> Bool
> :: Bindings -> Bindings -> Bool
$c> :: Bindings -> Bindings -> Bool
<= :: Bindings -> Bindings -> Bool
$c<= :: Bindings -> Bindings -> Bool
< :: Bindings -> Bindings -> Bool
$c< :: Bindings -> Bindings -> Bool
compare :: Bindings -> Bindings -> Ordering
$ccompare :: Bindings -> Bindings -> Ordering
$cp1Ord :: Eq Bindings
Ord,Int -> Bindings -> ShowS
[Bindings] -> ShowS
Bindings -> [Char]
(Int -> Bindings -> ShowS)
-> (Bindings -> [Char]) -> ([Bindings] -> ShowS) -> Show Bindings
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Bindings] -> ShowS
$cshowList :: [Bindings] -> ShowS
show :: Bindings -> [Char]
$cshow :: Bindings -> [Char]
showsPrec :: Int -> Bindings -> ShowS
$cshowsPrec :: Int -> Bindings -> ShowS
Show)

numberOfBoundVariables :: Bindings -> Int
numberOfBoundVariables :: Bindings -> Int
numberOfBoundVariables (Bindings [Dim]
ds) = [Dim] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Dim]
ds

dimensionTable :: Bindings -> Map Var Dim
dimensionTable :: Bindings -> Map Var Dim
dimensionTable (Bindings [Dim]
dims) = [(Var, Dim)] -> Map Var Dim
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Var, Dim)] -> Map Var Dim) -> [(Var, Dim)] -> Map Var Dim
forall a b. (a -> b) -> a -> b
$ [Var] -> [Dim] -> [(Var, Dim)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((Int -> Var) -> [Int] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Var
DeBruijn [Int
0..]) [Dim]
dims

--------------------------------------------------------------------------------

-- | An expression living on @Sym^n(X)@, with free variables
newtype Single
  = Single [(Var,Int)]
  deriving (Single -> Single -> Bool
(Single -> Single -> Bool)
-> (Single -> Single -> Bool) -> Eq Single
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Single -> Single -> Bool
$c/= :: Single -> Single -> Bool
== :: Single -> Single -> Bool
$c== :: Single -> Single -> Bool
Eq,Eq Single
Eq Single
-> (Single -> Single -> Ordering)
-> (Single -> Single -> Bool)
-> (Single -> Single -> Bool)
-> (Single -> Single -> Bool)
-> (Single -> Single -> Bool)
-> (Single -> Single -> Single)
-> (Single -> Single -> Single)
-> Ord Single
Single -> Single -> Bool
Single -> Single -> Ordering
Single -> Single -> Single
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
min :: Single -> Single -> Single
$cmin :: Single -> Single -> Single
max :: Single -> Single -> Single
$cmax :: Single -> Single -> Single
>= :: Single -> Single -> Bool
$c>= :: Single -> Single -> Bool
> :: Single -> Single -> Bool
$c> :: Single -> Single -> Bool
<= :: Single -> Single -> Bool
$c<= :: Single -> Single -> Bool
< :: Single -> Single -> Bool
$c< :: Single -> Single -> Bool
compare :: Single -> Single -> Ordering
$ccompare :: Single -> Single -> Ordering
$cp1Ord :: Eq Single
Ord,Int -> Single -> ShowS
[Single] -> ShowS
Single -> [Char]
(Int -> Single -> ShowS)
-> (Single -> [Char]) -> ([Single] -> ShowS) -> Show Single
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Single] -> ShowS
$cshowList :: [Single] -> ShowS
show :: Single -> [Char]
$cshow :: Single -> [Char]
showsPrec :: Int -> Single -> ShowS
$cshowsPrec :: Int -> Single -> ShowS
Show)

unSingle :: Single -> [(Var,Int)]
unSingle :: Single -> [(Var, Int)]
unSingle (Single [(Var, Int)]
ves) = [(Var, Int)]
ves

-- | An expression living on @Sym^{n_1}(X) x ... x Sym^{n_r}(X)@, with free variables
newtype Multi
  = Multi [Single]
  deriving (Multi -> Multi -> Bool
(Multi -> Multi -> Bool) -> (Multi -> Multi -> Bool) -> Eq Multi
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Multi -> Multi -> Bool
$c/= :: Multi -> Multi -> Bool
== :: Multi -> Multi -> Bool
$c== :: Multi -> Multi -> Bool
Eq,Eq Multi
Eq Multi
-> (Multi -> Multi -> Ordering)
-> (Multi -> Multi -> Bool)
-> (Multi -> Multi -> Bool)
-> (Multi -> Multi -> Bool)
-> (Multi -> Multi -> Bool)
-> (Multi -> Multi -> Multi)
-> (Multi -> Multi -> Multi)
-> Ord Multi
Multi -> Multi -> Bool
Multi -> Multi -> Ordering
Multi -> Multi -> Multi
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
min :: Multi -> Multi -> Multi
$cmin :: Multi -> Multi -> Multi
max :: Multi -> Multi -> Multi
$cmax :: Multi -> Multi -> Multi
>= :: Multi -> Multi -> Bool
$c>= :: Multi -> Multi -> Bool
> :: Multi -> Multi -> Bool
$c> :: Multi -> Multi -> Bool
<= :: Multi -> Multi -> Bool
$c<= :: Multi -> Multi -> Bool
< :: Multi -> Multi -> Bool
$c< :: Multi -> Multi -> Bool
compare :: Multi -> Multi -> Ordering
$ccompare :: Multi -> Multi -> Ordering
$cp1Ord :: Eq Multi
Ord,Int -> Multi -> ShowS
[Multi] -> ShowS
Multi -> [Char]
(Int -> Multi -> ShowS)
-> (Multi -> [Char]) -> ([Multi] -> ShowS) -> Show Multi
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Multi] -> ShowS
$cshowList :: [Multi] -> ShowS
show :: Multi -> [Char]
$cshow :: Multi -> [Char]
showsPrec :: Int -> Multi -> ShowS
$cshowsPrec :: Int -> Multi -> ShowS
Show)

-- | A lambda expression living on @Sym^n(X)@, with variables bound to @Sym^d(X)@ with different dimensions
data SingleLam
  = SingleLam !Bindings !Single
  deriving (SingleLam -> SingleLam -> Bool
(SingleLam -> SingleLam -> Bool)
-> (SingleLam -> SingleLam -> Bool) -> Eq SingleLam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SingleLam -> SingleLam -> Bool
$c/= :: SingleLam -> SingleLam -> Bool
== :: SingleLam -> SingleLam -> Bool
$c== :: SingleLam -> SingleLam -> Bool
Eq,Eq SingleLam
Eq SingleLam
-> (SingleLam -> SingleLam -> Ordering)
-> (SingleLam -> SingleLam -> Bool)
-> (SingleLam -> SingleLam -> Bool)
-> (SingleLam -> SingleLam -> Bool)
-> (SingleLam -> SingleLam -> Bool)
-> (SingleLam -> SingleLam -> SingleLam)
-> (SingleLam -> SingleLam -> SingleLam)
-> Ord SingleLam
SingleLam -> SingleLam -> Bool
SingleLam -> SingleLam -> Ordering
SingleLam -> SingleLam -> SingleLam
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
min :: SingleLam -> SingleLam -> SingleLam
$cmin :: SingleLam -> SingleLam -> SingleLam
max :: SingleLam -> SingleLam -> SingleLam
$cmax :: SingleLam -> SingleLam -> SingleLam
>= :: SingleLam -> SingleLam -> Bool
$c>= :: SingleLam -> SingleLam -> Bool
> :: SingleLam -> SingleLam -> Bool
$c> :: SingleLam -> SingleLam -> Bool
<= :: SingleLam -> SingleLam -> Bool
$c<= :: SingleLam -> SingleLam -> Bool
< :: SingleLam -> SingleLam -> Bool
$c< :: SingleLam -> SingleLam -> Bool
compare :: SingleLam -> SingleLam -> Ordering
$ccompare :: SingleLam -> SingleLam -> Ordering
$cp1Ord :: Eq SingleLam
Ord,Int -> SingleLam -> ShowS
[SingleLam] -> ShowS
SingleLam -> [Char]
(Int -> SingleLam -> ShowS)
-> (SingleLam -> [Char])
-> ([SingleLam] -> ShowS)
-> Show SingleLam
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [SingleLam] -> ShowS
$cshowList :: [SingleLam] -> ShowS
show :: SingleLam -> [Char]
$cshow :: SingleLam -> [Char]
showsPrec :: Int -> SingleLam -> ShowS
$cshowsPrec :: Int -> SingleLam -> ShowS
Show)

-- | A lambda expression living on @Sym^{n_1}(X) x ... x Sym^{n_r}(X)@, with variables bound to @Sym^d(X)@ with different dimensions
data MultiLam
  = MultiLam !Bindings !Multi
  deriving (MultiLam -> MultiLam -> Bool
(MultiLam -> MultiLam -> Bool)
-> (MultiLam -> MultiLam -> Bool) -> Eq MultiLam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MultiLam -> MultiLam -> Bool
$c/= :: MultiLam -> MultiLam -> Bool
== :: MultiLam -> MultiLam -> Bool
$c== :: MultiLam -> MultiLam -> Bool
Eq,Eq MultiLam
Eq MultiLam
-> (MultiLam -> MultiLam -> Ordering)
-> (MultiLam -> MultiLam -> Bool)
-> (MultiLam -> MultiLam -> Bool)
-> (MultiLam -> MultiLam -> Bool)
-> (MultiLam -> MultiLam -> Bool)
-> (MultiLam -> MultiLam -> MultiLam)
-> (MultiLam -> MultiLam -> MultiLam)
-> Ord MultiLam
MultiLam -> MultiLam -> Bool
MultiLam -> MultiLam -> Ordering
MultiLam -> MultiLam -> MultiLam
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
min :: MultiLam -> MultiLam -> MultiLam
$cmin :: MultiLam -> MultiLam -> MultiLam
max :: MultiLam -> MultiLam -> MultiLam
$cmax :: MultiLam -> MultiLam -> MultiLam
>= :: MultiLam -> MultiLam -> Bool
$c>= :: MultiLam -> MultiLam -> Bool
> :: MultiLam -> MultiLam -> Bool
$c> :: MultiLam -> MultiLam -> Bool
<= :: MultiLam -> MultiLam -> Bool
$c<= :: MultiLam -> MultiLam -> Bool
< :: MultiLam -> MultiLam -> Bool
$c< :: MultiLam -> MultiLam -> Bool
compare :: MultiLam -> MultiLam -> Ordering
$ccompare :: MultiLam -> MultiLam -> Ordering
$cp1Ord :: Eq MultiLam
Ord,Int -> MultiLam -> ShowS
[MultiLam] -> ShowS
MultiLam -> [Char]
(Int -> MultiLam -> ShowS)
-> (MultiLam -> [Char]) -> ([MultiLam] -> ShowS) -> Show MultiLam
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MultiLam] -> ShowS
$cshowList :: [MultiLam] -> ShowS
show :: MultiLam -> [Char]
$cshow :: MultiLam -> [Char]
showsPrec :: Int -> MultiLam -> ShowS
$cshowsPrec :: Int -> MultiLam -> ShowS
Show)

--------------------------------------------------------------------------------

instance Pretty Bindings where
  pretty :: Bindings -> [Char]
pretty (Bindings [Dim]
dims) = [Char]
"\\" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [[Char]] -> [Char]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((Var -> Dim -> [Char]) -> [Var] -> [Dim] -> [[Char]]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Var -> Dim -> [Char]
forall a a. (Pretty a, Show a) => a -> a -> [Char]
f [Var]
vars [Dim]
dims) where
    vars :: [Var]
vars = (Int -> Var) -> [Int] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Var
DeBruijn [Int
0..]
    f :: a -> a -> [Char]
f a
v a
d = [Char]
"(" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Pretty a => a -> [Char]
pretty a
v [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
":S" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
d [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
")"

instance Pretty Var where 
  pretty :: Var -> [Char]
pretty (DeBruijn Int
i) = Int -> Char
chr (Int
97 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) Char -> ShowS
forall a. a -> [a] -> [a]
: []

instance Pretty (Var,Int) where
  pretty :: (Var, Int) -> [Char]
pretty (Var
v,Int
0) = [Char]
"1"
  pretty (Var
v,Int
1) = Var -> [Char]
forall a. Pretty a => a -> [Char]
pretty Var
v
  pretty (Var
v,Int
e) = Var -> [Char]
forall a. Pretty a => a -> [Char]
pretty Var
v [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"^" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show Int
e

instance Pretty Single where
  pretty :: Single -> [Char]
pretty (Single [(Var, Int)]
ves) = [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"*" ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ ((Var, Int) -> [Char]) -> [(Var, Int)] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (Var, Int) -> [Char]
forall a. Pretty a => a -> [Char]
pretty [(Var, Int)]
ves

instance Pretty Multi where
  pretty :: Multi -> [Char]
pretty (Multi [Single]
ts) = [Char]
"[" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ ([Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
"," ([[Char]] -> [Char]) -> [[Char]] -> [Char]
forall a b. (a -> b) -> a -> b
$ (Single -> [Char]) -> [Single] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Single -> [Char]
forall a. Pretty a => a -> [Char]
pretty [Single]
ts) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"]"

instance Pretty SingleLam where
  pretty :: SingleLam -> [Char]
pretty (SingleLam Bindings
binds Single
body) = [Char]
"{" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Bindings -> [Char]
forall a. Pretty a => a -> [Char]
pretty Bindings
binds [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"->" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Single -> [Char]
forall a. Pretty a => a -> [Char]
pretty Single
body [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"}"

instance Pretty MultiLam where
  pretty :: MultiLam -> [Char]
pretty (MultiLam Bindings
binds Multi
body) = [Char]
"{" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Bindings -> [Char]
forall a. Pretty a => a -> [Char]
pretty Bindings
binds [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"->" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Multi -> [Char]
forall a. Pretty a => a -> [Char]
pretty Multi
body [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"}"

--------------------------------------------------------------------------------

instance Degree SingleLam where
  type MultiDegree SingleLam = Int
  multiDegree :: SingleLam -> MultiDegree SingleLam
multiDegree (SingleLam Bindings
binds (Single [(Var, Int)]
ves)) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ (Dim -> Int
unDim (Dim -> Int) -> Dim -> Int
forall a b. (a -> b) -> a -> b
$ Map Var Dim -> Var -> Dim
forall k a. Ord k => Map k a -> k -> a
(Map.!) Map Var Dim
dimTable Var
v) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
e | (Var
v,Int
e) <- [(Var, Int)]
ves ] where
    dimTable :: Map Var Dim
dimTable = Bindings -> Map Var Dim
dimensionTable Bindings
binds
  totalDegree :: SingleLam -> Int
totalDegree = SingleLam -> Int
forall a. Degree a => a -> MultiDegree a
multiDegree

instance Degree MultiLam where
  type MultiDegree MultiLam = [Int]
  multiDegree :: MultiLam -> MultiDegree MultiLam
multiDegree (MultiLam Bindings
binds (Multi [Single]
bodies)) = (SingleLam -> Int) -> [SingleLam] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map SingleLam -> Int
forall a. Degree a => a -> Int
totalDegree [ (Bindings -> Single -> SingleLam
SingleLam Bindings
binds Single
b) | Single
b <- [Single]
bodies ]
  totalDegree :: MultiLam -> Int
totalDegree = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> (MultiLam -> [Int]) -> MultiLam -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MultiLam -> [Int]
forall a. Degree a => a -> MultiDegree a
multiDegree

--------------------------------------------------------------------------------

instance Empty Bindings where
  empty :: Bindings
empty = [Dim] -> Bindings
Bindings []

instance Empty Single where
  empty :: Single
empty = [(Var, Int)] -> Single
Single []

instance Empty Multi where
  empty :: Multi
empty = [Single] -> Multi
Multi []

instance Empty SingleLam where
  empty :: SingleLam
empty = Bindings -> Single -> SingleLam
SingleLam Bindings
forall a. Empty a => a
empty Single
forall a. Empty a => a
empty

instance Empty MultiLam where
  empty :: MultiLam
empty = Bindings -> Multi -> MultiLam
MultiLam Bindings
forall a. Empty a => a
empty Multi
forall a. Empty a => a
empty

--------------------------------------------------------------------------------

-- | Shift de Bruijn levels
class Shift a where
  shift :: Int -> a -> a
  
instance Shift Var where
  shift :: Int -> Var -> Var
shift Int
k (DeBruijn Int
l) = Int -> Var
DeBruijn (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
l)

instance Shift Single where
  shift :: Int -> Single -> Single
shift Int
k (Single [(Var, Int)]
ves) = [(Var, Int)] -> Single
Single [ (Int -> Var -> Var
forall a. Shift a => Int -> a -> a
shift Int
k Var
v, Int
e) | (Var
v,Int
e) <- [(Var, Int)]
ves ]

instance Shift Multi where
  shift :: Int -> Multi -> Multi
shift Int
k (Multi [Single]
terms) = [Single] -> Multi
Multi ([Single] -> Multi) -> [Single] -> Multi
forall a b. (a -> b) -> a -> b
$ (Single -> Single) -> [Single] -> [Single]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Single -> Single
forall a. Shift a => Int -> a -> a
shift Int
k) [Single]
terms

--------------------------------------------------------------------------------

-- | Rename variables
class Rename a where
  rename :: (Var -> Var) -> a -> a

instance Rename Var where
  rename :: (Var -> Var) -> Var -> Var
rename Var -> Var
f Var
v = Var -> Var
f Var
v

instance Rename (Var,Int) where
  rename :: (Var -> Var) -> (Var, Int) -> (Var, Int)
rename Var -> Var
f (Var
v,Int
e) = (Var -> Var
f Var
v, Int
e)

instance Rename Single where
  rename :: (Var -> Var) -> Single -> Single
rename Var -> Var
f (Single [(Var, Int)]
ves) = [(Var, Int)] -> Single
Single ([(Var, Int)] -> Single) -> [(Var, Int)] -> Single
forall a b. (a -> b) -> a -> b
$ ((Var, Int) -> (Var, Int)) -> [(Var, Int)] -> [(Var, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Var -> Var) -> (Var, Int) -> (Var, Int)
forall a. Rename a => (Var -> Var) -> a -> a
rename Var -> Var
f) [(Var, Int)]
ves

instance Rename Multi where
  rename :: (Var -> Var) -> Multi -> Multi
rename Var -> Var
f (Multi [Single]
ts) = [Single] -> Multi
Multi ([Single] -> Multi) -> [Single] -> Multi
forall a b. (a -> b) -> a -> b
$ (Single -> Single) -> [Single] -> [Single]
forall a b. (a -> b) -> [a] -> [b]
map ((Var -> Var) -> Single -> Single
forall a. Rename a => (Var -> Var) -> a -> a
rename Var -> Var
f) [Single]
ts

--------------------------------------------------------------------------------

-- | Extract the exponent of a given variable
exponentOf :: Var -> Single -> Int
exponentOf :: Var -> Single -> Int
exponentOf Var
u (Single [(Var, Int)]
ves) = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum [ Int
e | (Var
v,Int
e) <- [(Var, Int)]
ves , Var
vVar -> Var -> Bool
forall a. Eq a => a -> a -> Bool
==Var
u ]

-- | Extract the exponent vector of a given variable
exponentVectorOf :: Var -> Multi -> [Int]
exponentVectorOf :: Var -> Multi -> [Int]
exponentVectorOf Var
v (Multi [Single]
ts) = (Single -> Int) -> [Single] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Var -> Single -> Int
exponentOf Var
v) [Single]
ts

--------------------------------------------------------------------------------

instance Normalize Single where
  normalize :: Single -> Single
normalize (Single [(Var, Int)]
ves) = [(Var, Int)] -> Single
Single ([(Var, Int)] -> Single) -> [(Var, Int)] -> Single
forall a b. (a -> b) -> a -> b
$ Map Var Int -> [(Var, Int)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Var Int -> [(Var, Int)]) -> Map Var Int -> [(Var, Int)]
forall a b. (a -> b) -> a -> b
$ (Int -> Int -> Int) -> [(Var, Int)] -> Map Var Int
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) [(Var, Int)]
ves

instance Normalize Multi where
  normalize :: Multi -> Multi
normalize (Multi [Single]
terms) = [Single] -> Multi
Multi ((Single -> Single) -> [Single] -> [Single]
forall a b. (a -> b) -> [a] -> [b]
map Single -> Single
forall a. Normalize a => a -> a
normalize [Single]
terms) 

normalizeWithExpo :: (Rename term, Normalize term, Ord expo) => (expo -> Bool) -> (Var -> term -> expo) -> (Bindings,term) -> (Bindings,term) 
normalizeWithExpo :: (expo -> Bool)
-> (Var -> term -> expo) -> (Bindings, term) -> (Bindings, term)
normalizeWithExpo expo -> Bool
cond Var -> term -> expo
expo (Bindings
binds,term
body) = (Bindings
binds',term
body') where
  Bindings [Dim]
dims = Bindings
binds
  vars :: [Var]
vars   = (Int -> Var) -> [Int] -> [Var]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Var
DeBruijn [Int
0..]
  vby :: [(Var, (Dim, expo))]
vby    = [ (Var
v,(Dim
d,expo
es)) | (Var
v,Dim
d) <- [Var] -> [Dim] -> [(Var, Dim)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Var]
vars [Dim]
dims , let es :: expo
es = Var -> term -> expo
expo Var
v term
body , expo -> Bool
cond expo
es ]
  sorted :: [(Var, (Dim, expo))]
sorted = ((Var, (Dim, expo)) -> (Dim, expo))
-> [(Var, (Dim, expo))] -> [(Var, (Dim, expo))]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (Var, (Dim, expo)) -> (Dim, expo)
forall a b. (a, b) -> b
snd [(Var, (Dim, expo))]
vby
  dims' :: [Dim]
dims'  = ((Var, (Dim, expo)) -> Dim) -> [(Var, (Dim, expo))] -> [Dim]
forall a b. (a -> b) -> [a] -> [b]
map ((Dim, expo) -> Dim
forall a b. (a, b) -> a
fst ((Dim, expo) -> Dim)
-> ((Var, (Dim, expo)) -> (Dim, expo)) -> (Var, (Dim, expo)) -> Dim
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Var, (Dim, expo)) -> (Dim, expo)
forall a b. (a, b) -> b
snd) [(Var, (Dim, expo))]
sorted
  binds' :: Bindings
binds' = [Dim] -> Bindings
Bindings [Dim]
dims'
  f :: Var -> Var
f Var
v    = Int -> Var
DeBruijn (Int -> Var) -> Int -> Var
forall a b. (a -> b) -> a -> b
$ Maybe Int -> Int
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ ((Var, (Dim, expo)) -> Bool) -> [(Var, (Dim, expo))] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex (\(Var, (Dim, expo))
pair -> (Var, (Dim, expo)) -> Var
forall a b. (a, b) -> a
fst (Var, (Dim, expo))
pair Var -> Var -> Bool
forall a. Eq a => a -> a -> Bool
== Var
v) [(Var, (Dim, expo))]
sorted
  body' :: term
body'  = term -> term
forall a. Normalize a => a -> a
normalize (term -> term) -> term -> term
forall a b. (a -> b) -> a -> b
$ (Var -> Var) -> term -> term
forall a. Rename a => (Var -> Var) -> a -> a
rename Var -> Var
f (term -> term) -> term -> term
forall a b. (a -> b) -> a -> b
$ term
body

instance Normalize SingleLam where
  normalize :: SingleLam -> SingleLam
normalize (SingleLam Bindings
binds Single
body) = Bindings -> Single -> SingleLam
SingleLam Bindings
binds' Single
body' where
    (Bindings
binds',Single
body') = (Int -> Bool)
-> (Var -> Single -> Int)
-> (Bindings, Single)
-> (Bindings, Single)
forall term expo.
(Rename term, Normalize term, Ord expo) =>
(expo -> Bool)
-> (Var -> term -> expo) -> (Bindings, term) -> (Bindings, term)
normalizeWithExpo (Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>Int
0) Var -> Single -> Int
exponentOf (Bindings
binds,Single
body)

instance Normalize MultiLam where
  normalize :: MultiLam -> MultiLam
normalize (MultiLam Bindings
binds Multi
body) = Bindings -> Multi -> MultiLam
MultiLam Bindings
binds' Multi
body' where
    cond :: t a -> Bool
cond t a
ds = (a -> Bool) -> t a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (a -> a -> Bool
forall a. Ord a => a -> a -> Bool
>a
0) t a
ds
    (Bindings
binds',Multi
body') = ([Int] -> Bool)
-> (Var -> Multi -> [Int])
-> (Bindings, Multi)
-> (Bindings, Multi)
forall term expo.
(Rename term, Normalize term, Ord expo) =>
(expo -> Bool)
-> (Var -> term -> expo) -> (Bindings, term) -> (Bindings, term)
normalizeWithExpo [Int] -> Bool
forall (t :: * -> *) a. (Foldable t, Ord a, Num a) => t a -> Bool
cond Var -> Multi -> [Int]
f (Bindings
binds,Multi
body)
    f :: Var -> Multi -> [Int]
f Var
v = {- reverse . -} Var -> Multi -> [Int]
exponentVectorOf Var
v

instance (Eq c, Num c) => Normalize (FreeMod c SingleLam) where
  normalize :: FreeMod c SingleLam -> FreeMod c SingleLam
normalize = (SingleLam -> SingleLam)
-> FreeMod c SingleLam -> FreeMod c SingleLam
forall a b c.
(Ord a, Ord b, Eq c, Num c) =>
(a -> b) -> FreeMod c a -> FreeMod c b
ZMod.mapBase SingleLam -> SingleLam
forall a. Normalize a => a -> a
normalize

instance (Eq c, Num c) => Normalize (FreeMod c MultiLam) where
  normalize :: FreeMod c MultiLam -> FreeMod c MultiLam
normalize = (MultiLam -> MultiLam) -> FreeMod c MultiLam -> FreeMod c MultiLam
forall a b c.
(Ord a, Ord b, Eq c, Num c) =>
(a -> b) -> FreeMod c a -> FreeMod c b
ZMod.mapBase MultiLam -> MultiLam
forall a. Normalize a => a -> a
normalize

--------------------------------------------------------------------------------

instance SuperNormalize Multi where
  superNormalize :: Multi -> Multi
superNormalize (Multi [Single]
ts) = [Single] -> Multi
Multi ([Single] -> Multi) -> [Single] -> Multi
forall a b. (a -> b) -> a -> b
$ [Single] -> [Single]
forall a. [a] -> [a]
reverse ([Single] -> [Single]) -> [Single] -> [Single]
forall a b. (a -> b) -> a -> b
$ (Single -> Bool) -> [Single] -> [Single]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Single -> Bool
isempty ([Single] -> [Single]) -> [Single] -> [Single]
forall a b. (a -> b) -> a -> b
$ [Single] -> [Single]
forall a. [a] -> [a]
reverse ([Single] -> [Single]) -> [Single] -> [Single]
forall a b. (a -> b) -> a -> b
$ (Single -> Single) -> [Single] -> [Single]
forall a b. (a -> b) -> [a] -> [b]
map Single -> Single
forall a. Normalize a => a -> a
normalize ([Single] -> [Single]) -> [Single] -> [Single]
forall a b. (a -> b) -> a -> b
$ [Single]
ts where
    isempty :: Single -> Bool
isempty (Single [(Var, Int)]
xs) = [(Var, Int)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Var, Int)]
xs

instance SuperNormalize MultiLam where
  superNormalize :: MultiLam -> MultiLam
superNormalize MultiLam
mlam = Bindings -> Multi -> MultiLam
MultiLam Bindings
binds (Multi -> Multi
forall a. SuperNormalize a => a -> a
superNormalize Multi
body) where
    (MultiLam Bindings
binds Multi
body) = MultiLam -> MultiLam
forall a. Normalize a => a -> a
normalize MultiLam
mlam

instance (Eq c, Num c) => SuperNormalize (FreeMod c MultiLam) where
  superNormalize :: FreeMod c MultiLam -> FreeMod c MultiLam
superNormalize = (MultiLam -> MultiLam) -> FreeMod c MultiLam -> FreeMod c MultiLam
forall a b c.
(Ord a, Ord b, Eq c, Num c) =>
(a -> b) -> FreeMod c a -> FreeMod c b
ZMod.mapBase MultiLam -> MultiLam
forall a. SuperNormalize a => a -> a
superNormalize
  
--------------------------------------------------------------------------------

instance Cross Bindings where
  cross :: Bindings -> Bindings -> Bindings
cross (Bindings [Dim]
ds) (Bindings [Dim]
es) = [Dim] -> Bindings
Bindings ([Dim]
ds[Dim] -> [Dim] -> [Dim]
forall a. [a] -> [a] -> [a]
++[Dim]
es)
  crossInterleave :: Bindings -> Bindings -> Bindings
crossInterleave = [Char] -> Bindings -> Bindings -> Bindings
forall a. HasCallStack => [Char] -> a
error [Char]
"Bindings/crossInterleave: undefined"
  
instance Cross Multi where
  cross :: Multi -> Multi -> Multi
cross (Multi [Single]
xs) (Multi [Single]
ys) = [Single] -> Multi
Multi ([Single]
xs[Single] -> [Single] -> [Single]
forall a. [a] -> [a] -> [a]
++[Single]
ys)
  crossInterleave :: Multi -> Multi -> Multi
crossInterleave (Multi [Single]
xs) (Multi [Single]
ys) = [Single] -> Multi
Multi ([Single] -> [Single] -> [Single]
forall a. [a] -> [a] -> [a]
interleave [Single]
xs [Single]
ys)

instance Cross MultiLam where
  cross :: MultiLam -> MultiLam -> MultiLam
cross (MultiLam Bindings
binds1 Multi
bodies1) (MultiLam Bindings
binds2 Multi
bodies2) = MultiLam -> MultiLam
forall a. Normalize a => a -> a
normalize (MultiLam -> MultiLam) -> MultiLam -> MultiLam
forall a b. (a -> b) -> a -> b
$ Bindings -> Multi -> MultiLam
MultiLam Bindings
binds3 Multi
bodies3 where
    n1 :: Int
n1 = Bindings -> Int
numberOfBoundVariables Bindings
binds1
    binds3 :: Bindings
binds3  = Bindings
binds1  Bindings -> Bindings -> Bindings
forall a. Cross a => a -> a -> a
`cross` Bindings
binds2
    bodies3 :: Multi
bodies3 = Multi
bodies1 Multi -> Multi -> Multi
forall a. Cross a => a -> a -> a
`cross` (Int -> Multi -> Multi
forall a. Shift a => Int -> a -> a
shift Int
n1 Multi
bodies2)

  crossInterleave :: MultiLam -> MultiLam -> MultiLam
crossInterleave (MultiLam Bindings
binds1 Multi
bodies1) (MultiLam Bindings
binds2 Multi
bodies2) = MultiLam -> MultiLam
forall a. Normalize a => a -> a
normalize (MultiLam -> MultiLam) -> MultiLam -> MultiLam
forall a b. (a -> b) -> a -> b
$ Bindings -> Multi -> MultiLam
MultiLam Bindings
binds3 Multi
bodies3 where
    n1 :: Int
n1 = Bindings -> Int
numberOfBoundVariables Bindings
binds1
    binds3 :: Bindings
binds3  = Bindings
binds1  Bindings -> Bindings -> Bindings
forall a. Cross a => a -> a -> a
`cross` Bindings
binds2
    bodies3 :: Multi
bodies3 = Multi
bodies1 Multi -> Multi -> Multi
forall a. Cross a => a -> a -> a
`crossInterleave` (Int -> Multi -> Multi
forall a. Shift a => Int -> a -> a
shift Int
n1 Multi
bodies2)

instance (Eq c, Num c) => Cross (FreeMod c MultiLam) where
  cross :: FreeMod c MultiLam -> FreeMod c MultiLam -> FreeMod c MultiLam
cross FreeMod c MultiLam
x FreeMod c MultiLam
y = FreeMod c MultiLam -> FreeMod c MultiLam
forall a. Normalize a => a -> a
normalize (FreeMod c MultiLam -> FreeMod c MultiLam)
-> FreeMod c MultiLam -> FreeMod c MultiLam
forall a b. (a -> b) -> a -> b
$ (MultiLam -> MultiLam -> MultiLam)
-> FreeMod c MultiLam -> FreeMod c MultiLam -> FreeMod c MultiLam
forall b c.
(Ord b, Eq c, Num c) =>
(b -> b -> b) -> FreeMod c b -> FreeMod c b -> FreeMod c b
ZMod.mulWith MultiLam -> MultiLam -> MultiLam
forall a. Cross a => a -> a -> a
cross FreeMod c MultiLam
x FreeMod c MultiLam
y
  crossInterleave :: FreeMod c MultiLam -> FreeMod c MultiLam -> FreeMod c MultiLam
crossInterleave FreeMod c MultiLam
x FreeMod c MultiLam
y = FreeMod c MultiLam -> FreeMod c MultiLam
forall a. Normalize a => a -> a
normalize (FreeMod c MultiLam -> FreeMod c MultiLam)
-> FreeMod c MultiLam -> FreeMod c MultiLam
forall a b. (a -> b) -> a -> b
$ (MultiLam -> MultiLam -> MultiLam)
-> FreeMod c MultiLam -> FreeMod c MultiLam -> FreeMod c MultiLam
forall b c.
(Ord b, Eq c, Num c) =>
(b -> b -> b) -> FreeMod c b -> FreeMod c b -> FreeMod c b
ZMod.mulWith MultiLam -> MultiLam -> MultiLam
forall a. Cross a => a -> a -> a
crossInterleave FreeMod c MultiLam
x FreeMod c MultiLam
y

--------------------------------------------------------------------------------

instance SingleToMulti Single Multi where
  singleToMulti :: Single -> Multi
singleToMulti = [Single] -> Multi
Multi ([Single] -> Multi) -> (Single -> [Single]) -> Single -> Multi
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Single -> [Single] -> [Single]
forall a. a -> [a] -> [a]
:[])

instance SingleToMulti SingleLam MultiLam where
  singleToMulti :: SingleLam -> MultiLam
singleToMulti (SingleLam Bindings
binds Single
single) = Bindings -> Multi -> MultiLam
MultiLam Bindings
binds ([Single] -> Multi
Multi [Single
single])

instance (Eq c, Num c) => SingleToMulti (FreeMod c SingleLam) (FreeMod c MultiLam) where
  singleToMulti :: FreeMod c SingleLam -> FreeMod c MultiLam
singleToMulti = (SingleLam -> MultiLam)
-> FreeMod c SingleLam -> FreeMod c MultiLam
forall a b c.
(Ord a, Ord b, Eq c, Num c) =>
(a -> b) -> FreeMod c a -> FreeMod c b
ZMod.mapBase SingleLam -> MultiLam
forall s t. SingleToMulti s t => s -> t
singleToMulti

--------------------------------------------------------------------------------

instance Omega (Var,Int) where
  omega :: Int -> (Var, Int) -> (Var, Int)
omega Int
0 (Var, Int)
_     = (Var, Int)
forall a. a
omegaZeroError 
  omega Int
k (Var
v,Int
d) = (Var
v,Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
*Int
k)

instance Omega Single where
  omega :: Int -> Single -> Single
omega Int
0 Single
_            = [(Var, Int)] -> Single
Single [] -- omegaZeroError 
  omega Int
k (Single [(Var, Int)]
ves) = [(Var, Int)] -> Single
Single ([(Var, Int)] -> Single) -> [(Var, Int)] -> Single
forall a b. (a -> b) -> a -> b
$ ((Var, Int) -> (Var, Int)) -> [(Var, Int)] -> [(Var, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> (Var, Int) -> (Var, Int)
forall a. Omega a => Int -> a -> a
omega Int
k) [(Var, Int)]
ves

instance Omega Multi where
  omega :: Int -> Multi -> Multi
omega Int
0 Multi
_          = Multi
forall a. a
omegaZeroError 
  omega Int
k (Multi [Single]
ts) = [Single] -> Multi
Multi ([Single] -> Multi) -> [Single] -> Multi
forall a b. (a -> b) -> a -> b
$ (Single -> Single) -> [Single] -> [Single]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Single -> Single
forall a. Omega a => Int -> a -> a
omega Int
k) [Single]
ts

instance Omega SingleLam where
  omega :: Int -> SingleLam -> SingleLam
omega Int
0 SingleLam
_                      = SingleLam
forall a. a
omegaZeroError 
  omega Int
k (SingleLam Bindings
binds Single
body) = Bindings -> Single -> SingleLam
SingleLam Bindings
binds (Int -> Single -> Single
forall a. Omega a => Int -> a -> a
omega Int
k Single
body)

instance Omega MultiLam where
  omega :: Int -> MultiLam -> MultiLam
omega Int
0 MultiLam
_                     = MultiLam
forall a. a
omegaZeroError 
  omega Int
k (MultiLam Bindings
binds Multi
body) = Bindings -> Multi -> MultiLam
MultiLam Bindings
binds (Int -> Multi -> Multi
forall a. Omega a => Int -> a -> a
omega Int
k Multi
body)

instance (Eq c, Num c) => Omega (FreeMod c SingleLam) where
  omega :: Int -> FreeMod c SingleLam -> FreeMod c SingleLam
omega Int
0 = FreeMod c SingleLam -> FreeMod c SingleLam
forall a. a
omegaZeroError 
  omega Int
k = (SingleLam -> SingleLam)
-> FreeMod c SingleLam -> FreeMod c SingleLam
forall a b c.
(Ord a, Ord b, Eq c, Num c) =>
(a -> b) -> FreeMod c a -> FreeMod c b
ZMod.mapBase (Int -> SingleLam -> SingleLam
forall a. Omega a => Int -> a -> a
omega Int
k)

instance (Eq c, Num c) => Omega (FreeMod c MultiLam) where
  omega :: Int -> FreeMod c MultiLam -> FreeMod c MultiLam
omega Int
0 = FreeMod c MultiLam -> FreeMod c MultiLam
forall a. a
omegaZeroError 
  omega Int
k = FreeMod c MultiLam -> FreeMod c MultiLam
forall a. Normalize a => a -> a
normalize (FreeMod c MultiLam -> FreeMod c MultiLam)
-> (FreeMod c MultiLam -> FreeMod c MultiLam)
-> FreeMod c MultiLam
-> FreeMod c MultiLam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MultiLam -> MultiLam) -> FreeMod c MultiLam -> FreeMod c MultiLam
forall a b c.
(Ord a, Ord b, Eq c, Num c) =>
(a -> b) -> FreeMod c a -> FreeMod c b
ZMod.mapBase (Int -> MultiLam -> MultiLam
forall a. Omega a => Int -> a -> a
omega Int
k)

--------------------------------------------------------------------------------

instance Omega123 Multi where
  omega123 :: Multi -> Multi
omega123 (Multi [Single]
ts) = [Single] -> Multi
Multi ([Single] -> Multi) -> [Single] -> Multi
forall a b. (a -> b) -> a -> b
$ (Int -> Single -> Single) -> [Int] -> [Single] -> [Single]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> Single -> Single
forall a. Omega a => Int -> a -> a
omega [Int
1..] [Single]
ts

instance Omega123 MultiLam where
  omega123 :: MultiLam -> MultiLam
omega123 (MultiLam Bindings
binds Multi
body) = Bindings -> Multi -> MultiLam
MultiLam Bindings
binds (Multi -> Multi
forall a. Omega123 a => a -> a
omega123 Multi
body)

instance (Eq c, Num c) => Omega123 (FreeMod c MultiLam) where
  omega123 :: FreeMod c MultiLam -> FreeMod c MultiLam
omega123 = FreeMod c MultiLam -> FreeMod c MultiLam
forall a. Normalize a => a -> a
normalize (FreeMod c MultiLam -> FreeMod c MultiLam)
-> (FreeMod c MultiLam -> FreeMod c MultiLam)
-> FreeMod c MultiLam
-> FreeMod c MultiLam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MultiLam -> MultiLam) -> FreeMod c MultiLam -> FreeMod c MultiLam
forall a b c.
(Ord a, Ord b, Eq c, Num c) =>
(a -> b) -> FreeMod c a -> FreeMod c b
ZMod.mapBase MultiLam -> MultiLam
forall a. Omega123 a => a -> a
omega123

--------------------------------------------------------------------------------

instance Psi Multi Single where
  psi :: Multi -> Single
psi (Multi [Single]
ts) = Single -> Single
forall a. Normalize a => a -> a
normalize (Single -> Single) -> Single -> Single
forall a b. (a -> b) -> a -> b
$ [(Var, Int)] -> Single
Single ([(Var, Int)] -> Single) -> [(Var, Int)] -> Single
forall a b. (a -> b) -> a -> b
$ [[(Var, Int)]] -> [(Var, Int)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(Var, Int)]] -> [(Var, Int)]) -> [[(Var, Int)]] -> [(Var, Int)]
forall a b. (a -> b) -> a -> b
$ (Single -> [(Var, Int)]) -> [Single] -> [[(Var, Int)]]
forall a b. (a -> b) -> [a] -> [b]
map Single -> [(Var, Int)]
unSingle [Single]
ts

instance Psi MultiLam SingleLam where
  psi :: MultiLam -> SingleLam
psi (MultiLam Bindings
binds Multi
body) = Bindings -> Single -> SingleLam
SingleLam Bindings
binds (Multi -> Single
forall t s. Psi t s => t -> s
psi Multi
body)

instance (Eq c, Num c) => Psi (FreeMod c MultiLam) (FreeMod c SingleLam) where
  psi :: FreeMod c MultiLam -> FreeMod c SingleLam
psi = FreeMod c SingleLam -> FreeMod c SingleLam
forall a. Normalize a => a -> a
normalize (FreeMod c SingleLam -> FreeMod c SingleLam)
-> (FreeMod c MultiLam -> FreeMod c SingleLam)
-> FreeMod c MultiLam
-> FreeMod c SingleLam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MultiLam -> SingleLam)
-> FreeMod c MultiLam -> FreeMod c SingleLam
forall a b c.
(Ord a, Ord b, Eq c, Num c) =>
(a -> b) -> FreeMod c a -> FreeMod c b
ZMod.mapBase MultiLam -> SingleLam
forall t s. Psi t s => t -> s
psi

instance (Eq c, Num c) => Psi [FreeMod c SingleLam] (FreeMod c SingleLam) where
  psi :: [FreeMod c SingleLam] -> FreeMod c SingleLam
psi = FreeMod c SingleLam -> FreeMod c SingleLam
forall a. Normalize a => a -> a
normalize (FreeMod c SingleLam -> FreeMod c SingleLam)
-> ([FreeMod c SingleLam] -> FreeMod c SingleLam)
-> [FreeMod c SingleLam]
-> FreeMod c SingleLam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeMod c MultiLam -> FreeMod c SingleLam
forall t s. Psi t s => t -> s
psi (FreeMod c MultiLam -> FreeMod c SingleLam)
-> ([FreeMod c SingleLam] -> FreeMod c MultiLam)
-> [FreeMod c SingleLam]
-> FreeMod c SingleLam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FreeMod c MultiLam] -> FreeMod c MultiLam
forall a. Cross a => [a] -> a
crossMany ([FreeMod c MultiLam] -> FreeMod c MultiLam)
-> ([FreeMod c SingleLam] -> [FreeMod c MultiLam])
-> [FreeMod c SingleLam]
-> FreeMod c MultiLam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FreeMod c SingleLam -> FreeMod c MultiLam)
-> [FreeMod c SingleLam] -> [FreeMod c MultiLam]
forall a b. (a -> b) -> [a] -> [b]
map FreeMod c SingleLam -> FreeMod c MultiLam
forall s t. SingleToMulti s t => s -> t
singleToMulti

--------------------------------------------------------------------------------

instance PsiEvenOdd Multi where
  psiEvenOdd :: Multi -> Multi
psiEvenOdd (Multi [Single]
ts) = Multi -> Multi
forall a. Normalize a => a -> a
normalize (Multi -> Multi) -> Multi -> Multi
forall a b. (a -> b) -> a -> b
$ [Single] -> Multi
Multi ([Single] -> Multi) -> [Single] -> Multi
forall a b. (a -> b) -> a -> b
$ (Single -> Single -> Single) -> [Single] -> [Single] -> [Single]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Single -> Single -> Single
f ([Single] -> [Single]
forall a. [a] -> [a]
evens [Single]
ts) ([Single] -> [Single]
forall a. [a] -> [a]
odds [Single]
ts) where
    f :: Single -> Single -> Single
f (Single [(Var, Int)]
xs) (Single [(Var, Int)]
ys) = [(Var, Int)] -> Single
Single ([(Var, Int)]
xs[(Var, Int)] -> [(Var, Int)] -> [(Var, Int)]
forall a. [a] -> [a] -> [a]
++[(Var, Int)]
ys)

instance PsiEvenOdd MultiLam where
  psiEvenOdd :: MultiLam -> MultiLam
psiEvenOdd (MultiLam Bindings
binds Multi
body) = Bindings -> Multi -> MultiLam
MultiLam Bindings
binds (Multi -> Multi
forall t. PsiEvenOdd t => t -> t
psiEvenOdd Multi
body)

instance PsiEvenOdd (ZMod MultiLam) where
  psiEvenOdd :: ZMod MultiLam -> ZMod MultiLam
psiEvenOdd = ZMod MultiLam -> ZMod MultiLam
forall a. Normalize a => a -> a
normalize (ZMod MultiLam -> ZMod MultiLam)
-> (ZMod MultiLam -> ZMod MultiLam)
-> ZMod MultiLam
-> ZMod MultiLam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MultiLam -> MultiLam) -> ZMod MultiLam -> ZMod MultiLam
forall a b c.
(Ord a, Ord b, Eq c, Num c) =>
(a -> b) -> FreeMod c a -> FreeMod c b
ZMod.mapBase MultiLam -> MultiLam
forall t. PsiEvenOdd t => t -> t
psiEvenOdd

--------------------------------------------------------------------------------

instance Pontrjagin SingleLam where
  pontrjaginOne :: SingleLam
pontrjaginOne     = SingleLam
forall a. Empty a => a
empty
  pontrjaginMul :: SingleLam -> SingleLam -> SingleLam
pontrjaginMul SingleLam
a SingleLam
b = MultiLam -> SingleLam
forall t s. Psi t s => t -> s
psi (MultiLam -> SingleLam) -> MultiLam -> SingleLam
forall a b. (a -> b) -> a -> b
$ MultiLam -> MultiLam -> MultiLam
forall a. Cross a => a -> a -> a
cross (SingleLam -> MultiLam
forall s t. SingleToMulti s t => s -> t
singleToMulti SingleLam
a) (SingleLam -> MultiLam
forall s t. SingleToMulti s t => s -> t
singleToMulti SingleLam
b)

instance Pontrjagin MultiLam where
  pontrjaginOne :: MultiLam
pontrjaginOne     = MultiLam
forall a. Empty a => a
empty
  pontrjaginMul :: MultiLam -> MultiLam -> MultiLam
pontrjaginMul MultiLam
a MultiLam
b = MultiLam -> MultiLam
forall t. PsiEvenOdd t => t -> t
psiEvenOdd (MultiLam -> MultiLam) -> MultiLam -> MultiLam
forall a b. (a -> b) -> a -> b
$ MultiLam -> MultiLam -> MultiLam
forall a. Cross a => a -> a -> a
crossInterleave MultiLam
a' MultiLam
b' where
    (MultiLam
a',MultiLam
b') = (MultiLam, MultiLam) -> (MultiLam, MultiLam)
forall a. ExtendToCommonSize a => (a, a) -> (a, a)
extendToCommonSize (MultiLam
a,MultiLam
b)

--------------------------------------------------------------------------------

instance ExtendToCommonSize Multi where
  extendToCommonSize :: (Multi, Multi) -> (Multi, Multi)
extendToCommonSize (Multi [Single]
xs, Multi [Single]
ys) = ([Single] -> Multi
Multi [Single]
xs', [Single] -> Multi
Multi [Single]
ys') where
    ([Single]
xs',[Single]
ys') = ([Single], [Single]) -> ([Single], [Single])
forall a. ExtendToCommonSize a => (a, a) -> (a, a)
extendToCommonSize ([Single]
xs,[Single]
ys) 

instance ExtendToCommonSize MultiLam where
  extendToCommonSize :: (MultiLam, MultiLam) -> (MultiLam, MultiLam)
extendToCommonSize (MultiLam Bindings
as Multi
xs, MultiLam Bindings
bs Multi
ys) = (Bindings -> Multi -> MultiLam
MultiLam Bindings
as Multi
xs', Bindings -> Multi -> MultiLam
MultiLam Bindings
bs Multi
ys') where
    (Multi
xs',Multi
ys') = (Multi, Multi) -> (Multi, Multi)
forall a. ExtendToCommonSize a => (a, a) -> (a, a)
extendToCommonSize (Multi
xs,Multi
ys) 

--------------------------------------------------------------------------------

instance Permute Multi where
  permute :: Permutation -> Multi -> Multi
permute Permutation
p (Multi [Single]
ts) = [Single] -> Multi
Multi (Permutation -> [Single] -> [Single]
forall a. Permutation -> [a] -> [a]
permuteList Permutation
p [Single]
ts)

instance Permute MultiLam where
  permute :: Permutation -> MultiLam -> MultiLam
permute Permutation
p (MultiLam Bindings
binds Multi
multi) = Bindings -> Multi -> MultiLam
MultiLam Bindings
binds (Permutation -> Multi -> Multi
forall a. Permute a => Permutation -> a -> a
permute Permutation
p Multi
multi)

instance Permute (ZMod MultiLam) where
  permute :: Permutation -> ZMod MultiLam -> ZMod MultiLam
permute Permutation
p = (MultiLam -> MultiLam) -> ZMod MultiLam -> ZMod MultiLam
forall a b c.
(Ord a, Ord b, Eq c, Num c) =>
(a -> b) -> FreeMod c a -> FreeMod c b
ZMod.mapBase (Permutation -> MultiLam -> MultiLam
forall a. Permute a => Permutation -> a -> a
permute Permutation
p)

--------------------------------------------------------------------------------

instance Theta Multi where
  theta :: Multi -> Multi
theta (Multi (Single
u:[Single]
us)) = [Single] -> Multi
Multi (Single
aSingle -> [Single] -> [Single]
forall a. a -> [a] -> [a]
:[Single]
bs) where
    a :: Single
a = Multi -> Single
forall t s. Psi t s => t -> s
psi (Multi -> Single) -> Multi -> Single
forall a b. (a -> b) -> a -> b
$ [Single] -> Multi
Multi (Single
u Single -> [Single] -> [Single]
forall a. a -> [a] -> [a]
: [Single] -> [Single]
forall a. [a] -> [a]
odds [Single]
us)
    bs :: [Single]
bs = (Single -> Single -> Single) -> [Single] -> [Single] -> [Single]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Single -> Single -> Single
f ([Single] -> [Single]
forall a. [a] -> [a]
evens [Single]
us) ([Single] -> [Single]
forall a. [a] -> [a]
odds [Single]
us)
    f :: Single -> Single -> Single
f (Single [(Var, Int)]
u) (Single [(Var, Int)]
v) = Single -> Single
forall a. Normalize a => a -> a
normalize (Single -> Single) -> Single -> Single
forall a b. (a -> b) -> a -> b
$ [(Var, Int)] -> Single
Single ([(Var, Int)]
u [(Var, Int)] -> [(Var, Int)] -> [(Var, Int)]
forall a. [a] -> [a] -> [a]
++ [(Var, Int)]
v)

instance Theta MultiLam where
  theta :: MultiLam -> MultiLam
theta (MultiLam Bindings
binds Multi
body) = Bindings -> Multi -> MultiLam
MultiLam Bindings
binds (Multi -> Multi
forall a. Theta a => a -> a
theta Multi
body)

instance Theta (ZMod MultiLam) where
  theta :: ZMod MultiLam -> ZMod MultiLam
theta = ZMod MultiLam -> ZMod MultiLam
forall a. Normalize a => a -> a
normalize (ZMod MultiLam -> ZMod MultiLam)
-> (ZMod MultiLam -> ZMod MultiLam)
-> ZMod MultiLam
-> ZMod MultiLam
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MultiLam -> MultiLam) -> ZMod MultiLam -> ZMod MultiLam
forall a b c.
(Ord a, Ord b, Eq c, Num c) =>
(a -> b) -> FreeMod c a -> FreeMod c b
ZMod.mapBase MultiLam -> MultiLam
forall a. Theta a => a -> a
theta

--------------------------------------------------------------------------------