{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE CPP #-}
module Agda.Termination.CallMatrix where
#if __GLASGOW_HASKELL__ < 804
import Data.Semigroup
#endif
import Agda.Termination.CutOff
import Agda.Termination.Order as Order
import Agda.Termination.SparseMatrix as Matrix
import Agda.Termination.Semiring (HasZero(..))
import Agda.Utils.Favorites (Favorites)
import qualified Agda.Utils.Favorites as Fav
import Agda.Utils.Null
import Agda.Utils.PartialOrd
import Agda.Utils.Pretty
import Agda.Utils.Singleton
type ArgumentIndex = Int
newtype CallMatrix' a = CallMatrix { forall a. CallMatrix' a -> Matrix ArgumentIndex a
mat :: Matrix ArgumentIndex a }
deriving (CallMatrix' a -> CallMatrix' a -> Bool
forall a. Eq a => CallMatrix' a -> CallMatrix' a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CallMatrix' a -> CallMatrix' a -> Bool
$c/= :: forall a. Eq a => CallMatrix' a -> CallMatrix' a -> Bool
== :: CallMatrix' a -> CallMatrix' a -> Bool
$c== :: forall a. Eq a => CallMatrix' a -> CallMatrix' a -> Bool
Eq, CallMatrix' a -> CallMatrix' a -> Bool
CallMatrix' a -> CallMatrix' a -> Ordering
CallMatrix' a -> CallMatrix' a -> CallMatrix' a
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 {a}. Ord a => Eq (CallMatrix' a)
forall a. Ord a => CallMatrix' a -> CallMatrix' a -> Bool
forall a. Ord a => CallMatrix' a -> CallMatrix' a -> Ordering
forall a. Ord a => CallMatrix' a -> CallMatrix' a -> CallMatrix' a
min :: CallMatrix' a -> CallMatrix' a -> CallMatrix' a
$cmin :: forall a. Ord a => CallMatrix' a -> CallMatrix' a -> CallMatrix' a
max :: CallMatrix' a -> CallMatrix' a -> CallMatrix' a
$cmax :: forall a. Ord a => CallMatrix' a -> CallMatrix' a -> CallMatrix' a
>= :: CallMatrix' a -> CallMatrix' a -> Bool
$c>= :: forall a. Ord a => CallMatrix' a -> CallMatrix' a -> Bool
> :: CallMatrix' a -> CallMatrix' a -> Bool
$c> :: forall a. Ord a => CallMatrix' a -> CallMatrix' a -> Bool
<= :: CallMatrix' a -> CallMatrix' a -> Bool
$c<= :: forall a. Ord a => CallMatrix' a -> CallMatrix' a -> Bool
< :: CallMatrix' a -> CallMatrix' a -> Bool
$c< :: forall a. Ord a => CallMatrix' a -> CallMatrix' a -> Bool
compare :: CallMatrix' a -> CallMatrix' a -> Ordering
$ccompare :: forall a. Ord a => CallMatrix' a -> CallMatrix' a -> Ordering
Ord, ArgumentIndex -> CallMatrix' a -> ShowS
forall a.
(HasZero a, Show a) =>
ArgumentIndex -> CallMatrix' a -> ShowS
forall a. (HasZero a, Show a) => [CallMatrix' a] -> ShowS
forall a. (HasZero a, Show a) => CallMatrix' a -> String
forall a.
(ArgumentIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CallMatrix' a] -> ShowS
$cshowList :: forall a. (HasZero a, Show a) => [CallMatrix' a] -> ShowS
show :: CallMatrix' a -> String
$cshow :: forall a. (HasZero a, Show a) => CallMatrix' a -> String
showsPrec :: ArgumentIndex -> CallMatrix' a -> ShowS
$cshowsPrec :: forall a.
(HasZero a, Show a) =>
ArgumentIndex -> CallMatrix' a -> ShowS
Show, forall a b. a -> CallMatrix' b -> CallMatrix' a
forall a b. (a -> b) -> CallMatrix' a -> CallMatrix' b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CallMatrix' b -> CallMatrix' a
$c<$ :: forall a b. a -> CallMatrix' b -> CallMatrix' a
fmap :: forall a b. (a -> b) -> CallMatrix' a -> CallMatrix' b
$cfmap :: forall a b. (a -> b) -> CallMatrix' a -> CallMatrix' b
Functor, forall a. Eq a => a -> CallMatrix' a -> Bool
forall a. Num a => CallMatrix' a -> a
forall a. Ord a => CallMatrix' a -> a
forall m. Monoid m => CallMatrix' m -> m
forall a. CallMatrix' a -> Bool
forall a. CallMatrix' a -> ArgumentIndex
forall a. CallMatrix' a -> [a]
forall a. (a -> a -> a) -> CallMatrix' a -> a
forall m a. Monoid m => (a -> m) -> CallMatrix' a -> m
forall b a. (b -> a -> b) -> b -> CallMatrix' a -> b
forall a b. (a -> b -> b) -> b -> CallMatrix' a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> ArgumentIndex)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => CallMatrix' a -> a
$cproduct :: forall a. Num a => CallMatrix' a -> a
sum :: forall a. Num a => CallMatrix' a -> a
$csum :: forall a. Num a => CallMatrix' a -> a
minimum :: forall a. Ord a => CallMatrix' a -> a
$cminimum :: forall a. Ord a => CallMatrix' a -> a
maximum :: forall a. Ord a => CallMatrix' a -> a
$cmaximum :: forall a. Ord a => CallMatrix' a -> a
elem :: forall a. Eq a => a -> CallMatrix' a -> Bool
$celem :: forall a. Eq a => a -> CallMatrix' a -> Bool
length :: forall a. CallMatrix' a -> ArgumentIndex
$clength :: forall a. CallMatrix' a -> ArgumentIndex
null :: forall a. CallMatrix' a -> Bool
$cnull :: forall a. CallMatrix' a -> Bool
toList :: forall a. CallMatrix' a -> [a]
$ctoList :: forall a. CallMatrix' a -> [a]
foldl1 :: forall a. (a -> a -> a) -> CallMatrix' a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> CallMatrix' a -> a
foldr1 :: forall a. (a -> a -> a) -> CallMatrix' a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> CallMatrix' a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> CallMatrix' a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> CallMatrix' a -> b
foldl :: forall b a. (b -> a -> b) -> b -> CallMatrix' a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> CallMatrix' a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> CallMatrix' a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> CallMatrix' a -> b
foldr :: forall a b. (a -> b -> b) -> b -> CallMatrix' a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> CallMatrix' a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> CallMatrix' a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> CallMatrix' a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> CallMatrix' a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> CallMatrix' a -> m
fold :: forall m. Monoid m => CallMatrix' m -> m
$cfold :: forall m. Monoid m => CallMatrix' m -> m
Foldable, Functor CallMatrix'
Foldable CallMatrix'
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
CallMatrix' (m a) -> m (CallMatrix' a)
forall (f :: * -> *) a.
Applicative f =>
CallMatrix' (f a) -> f (CallMatrix' a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CallMatrix' a -> m (CallMatrix' b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CallMatrix' a -> f (CallMatrix' b)
sequence :: forall (m :: * -> *) a.
Monad m =>
CallMatrix' (m a) -> m (CallMatrix' a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
CallMatrix' (m a) -> m (CallMatrix' a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CallMatrix' a -> m (CallMatrix' b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> CallMatrix' a -> m (CallMatrix' b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
CallMatrix' (f a) -> f (CallMatrix' a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
CallMatrix' (f a) -> f (CallMatrix' a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CallMatrix' a -> f (CallMatrix' b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> CallMatrix' a -> f (CallMatrix' b)
Traversable, Comparable (CallMatrix' a)
forall a. PartialOrd a => Comparable (CallMatrix' a)
forall a. Comparable a -> PartialOrd a
comparable :: Comparable (CallMatrix' a)
$ccomparable :: forall a. PartialOrd a => Comparable (CallMatrix' a)
PartialOrd)
type CallMatrix = CallMatrix' Order
deriving instance NotWorse CallMatrix
instance HasZero a => Diagonal (CallMatrix' a) a where
diagonal :: CallMatrix' a -> [a]
diagonal = forall m e. Diagonal m e => m -> [e]
diagonal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CallMatrix' a -> Matrix ArgumentIndex a
mat
class CallComb a where
(>*<) :: (?cutoff :: CutOff) => a -> a -> a
instance CallComb CallMatrix where
CallMatrix Matrix ArgumentIndex Order
m1 >*< :: (?cutoff::CutOff) => CallMatrix -> CallMatrix -> CallMatrix
>*< CallMatrix Matrix ArgumentIndex Order
m2 = forall a. Matrix ArgumentIndex a -> CallMatrix' a
CallMatrix forall a b. (a -> b) -> a -> b
$ forall i a.
(Ix i, Eq a) =>
Semiring a -> Matrix i a -> Matrix i a -> Matrix i a
mul (?cutoff::CutOff) => Semiring Order
orderSemiring Matrix ArgumentIndex Order
m2 Matrix ArgumentIndex Order
m1
data CallMatrixAug cinfo = CallMatrixAug
{ forall cinfo. CallMatrixAug cinfo -> CallMatrix
augCallMatrix :: CallMatrix
, forall cinfo. CallMatrixAug cinfo -> cinfo
augCallInfo :: cinfo
}
deriving (CallMatrixAug cinfo -> CallMatrixAug cinfo -> Bool
forall cinfo.
Eq cinfo =>
CallMatrixAug cinfo -> CallMatrixAug cinfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CallMatrixAug cinfo -> CallMatrixAug cinfo -> Bool
$c/= :: forall cinfo.
Eq cinfo =>
CallMatrixAug cinfo -> CallMatrixAug cinfo -> Bool
== :: CallMatrixAug cinfo -> CallMatrixAug cinfo -> Bool
$c== :: forall cinfo.
Eq cinfo =>
CallMatrixAug cinfo -> CallMatrixAug cinfo -> Bool
Eq, ArgumentIndex -> CallMatrixAug cinfo -> ShowS
forall cinfo.
Show cinfo =>
ArgumentIndex -> CallMatrixAug cinfo -> ShowS
forall cinfo. Show cinfo => [CallMatrixAug cinfo] -> ShowS
forall cinfo. Show cinfo => CallMatrixAug cinfo -> String
forall a.
(ArgumentIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CallMatrixAug cinfo] -> ShowS
$cshowList :: forall cinfo. Show cinfo => [CallMatrixAug cinfo] -> ShowS
show :: CallMatrixAug cinfo -> String
$cshow :: forall cinfo. Show cinfo => CallMatrixAug cinfo -> String
showsPrec :: ArgumentIndex -> CallMatrixAug cinfo -> ShowS
$cshowsPrec :: forall cinfo.
Show cinfo =>
ArgumentIndex -> CallMatrixAug cinfo -> ShowS
Show)
instance Diagonal (CallMatrixAug cinfo) Order where
diagonal :: CallMatrixAug cinfo -> [Order]
diagonal = forall m e. Diagonal m e => m -> [e]
diagonal forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cinfo. CallMatrixAug cinfo -> CallMatrix
augCallMatrix
instance PartialOrd (CallMatrixAug cinfo) where
comparable :: Comparable (CallMatrixAug cinfo)
comparable CallMatrixAug cinfo
m CallMatrixAug cinfo
m' = forall a. PartialOrd a => Comparable a
comparable (forall cinfo. CallMatrixAug cinfo -> CallMatrix
augCallMatrix CallMatrixAug cinfo
m) (forall cinfo. CallMatrixAug cinfo -> CallMatrix
augCallMatrix CallMatrixAug cinfo
m')
instance NotWorse (CallMatrixAug cinfo) where
CallMatrixAug cinfo
c1 notWorse :: CallMatrixAug cinfo -> CallMatrixAug cinfo -> Bool
`notWorse` CallMatrixAug cinfo
c2 = forall cinfo. CallMatrixAug cinfo -> CallMatrix
augCallMatrix CallMatrixAug cinfo
c1 forall a. NotWorse a => a -> a -> Bool
`notWorse` forall cinfo. CallMatrixAug cinfo -> CallMatrix
augCallMatrix CallMatrixAug cinfo
c2
instance Monoid cinfo => CallComb (CallMatrixAug cinfo) where
CallMatrixAug CallMatrix
m1 cinfo
p1 >*< :: (?cutoff::CutOff) =>
CallMatrixAug cinfo -> CallMatrixAug cinfo -> CallMatrixAug cinfo
>*< CallMatrixAug CallMatrix
m2 cinfo
p2 =
forall cinfo. CallMatrix -> cinfo -> CallMatrixAug cinfo
CallMatrixAug (CallMatrix
m1 forall a. (CallComb a, ?cutoff::CutOff) => a -> a -> a
>*< CallMatrix
m2) (forall a. Monoid a => a -> a -> a
mappend cinfo
p1 cinfo
p2)
noAug :: Monoid cinfo => CallMatrix -> CallMatrixAug cinfo
noAug :: forall cinfo. Monoid cinfo => CallMatrix -> CallMatrixAug cinfo
noAug CallMatrix
m = forall cinfo. CallMatrix -> cinfo -> CallMatrixAug cinfo
CallMatrixAug CallMatrix
m forall a. Monoid a => a
mempty
newtype CMSet cinfo = CMSet { forall cinfo. CMSet cinfo -> Favorites (CallMatrixAug cinfo)
cmSet :: Favorites (CallMatrixAug cinfo) }
deriving ( ArgumentIndex -> CMSet cinfo -> ShowS
forall cinfo. Show cinfo => ArgumentIndex -> CMSet cinfo -> ShowS
forall cinfo. Show cinfo => [CMSet cinfo] -> ShowS
forall cinfo. Show cinfo => CMSet cinfo -> String
forall a.
(ArgumentIndex -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CMSet cinfo] -> ShowS
$cshowList :: forall cinfo. Show cinfo => [CMSet cinfo] -> ShowS
show :: CMSet cinfo -> String
$cshow :: forall cinfo. Show cinfo => CMSet cinfo -> String
showsPrec :: ArgumentIndex -> CMSet cinfo -> ShowS
$cshowsPrec :: forall cinfo. Show cinfo => ArgumentIndex -> CMSet cinfo -> ShowS
Show, NonEmpty (CMSet cinfo) -> CMSet cinfo
CMSet cinfo -> CMSet cinfo -> CMSet cinfo
forall b. Integral b => b -> CMSet cinfo -> CMSet cinfo
forall cinfo. NonEmpty (CMSet cinfo) -> CMSet cinfo
forall cinfo. CMSet cinfo -> CMSet cinfo -> CMSet cinfo
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall cinfo b. Integral b => b -> CMSet cinfo -> CMSet cinfo
stimes :: forall b. Integral b => b -> CMSet cinfo -> CMSet cinfo
$cstimes :: forall cinfo b. Integral b => b -> CMSet cinfo -> CMSet cinfo
sconcat :: NonEmpty (CMSet cinfo) -> CMSet cinfo
$csconcat :: forall cinfo. NonEmpty (CMSet cinfo) -> CMSet cinfo
<> :: CMSet cinfo -> CMSet cinfo -> CMSet cinfo
$c<> :: forall cinfo. CMSet cinfo -> CMSet cinfo -> CMSet cinfo
Semigroup, CMSet cinfo
[CMSet cinfo] -> CMSet cinfo
CMSet cinfo -> CMSet cinfo -> CMSet cinfo
forall cinfo. Semigroup (CMSet cinfo)
forall cinfo. CMSet cinfo
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall cinfo. [CMSet cinfo] -> CMSet cinfo
forall cinfo. CMSet cinfo -> CMSet cinfo -> CMSet cinfo
mconcat :: [CMSet cinfo] -> CMSet cinfo
$cmconcat :: forall cinfo. [CMSet cinfo] -> CMSet cinfo
mappend :: CMSet cinfo -> CMSet cinfo -> CMSet cinfo
$cmappend :: forall cinfo. CMSet cinfo -> CMSet cinfo -> CMSet cinfo
mempty :: CMSet cinfo
$cmempty :: forall cinfo. CMSet cinfo
Monoid, CMSet cinfo
CMSet cinfo -> Bool
forall cinfo. CMSet cinfo
forall a. a -> (a -> Bool) -> Null a
forall cinfo. CMSet cinfo -> Bool
null :: CMSet cinfo -> Bool
$cnull :: forall cinfo. CMSet cinfo -> Bool
empty :: CMSet cinfo
$cempty :: forall cinfo. CMSet cinfo
Null, Singleton (CallMatrixAug cinfo) )
instance Monoid cinfo => CallComb (CMSet cinfo) where
CMSet Favorites (CallMatrixAug cinfo)
as >*< :: (?cutoff::CutOff) => CMSet cinfo -> CMSet cinfo -> CMSet cinfo
>*< CMSet Favorites (CallMatrixAug cinfo)
bs = forall cinfo. Favorites (CallMatrixAug cinfo) -> CMSet cinfo
CMSet forall a b. (a -> b) -> a -> b
$ forall a. PartialOrd a => [a] -> Favorites a
Fav.fromList forall a b. (a -> b) -> a -> b
$
[ CallMatrixAug cinfo
a forall a. (CallComb a, ?cutoff::CutOff) => a -> a -> a
>*< CallMatrixAug cinfo
b | CallMatrixAug cinfo
a <- forall a. Favorites a -> [a]
Fav.toList Favorites (CallMatrixAug cinfo)
as, CallMatrixAug cinfo
b <- forall a. Favorites a -> [a]
Fav.toList Favorites (CallMatrixAug cinfo)
bs ]
insert :: CallMatrixAug cinfo -> CMSet cinfo -> CMSet cinfo
insert :: forall cinfo. CallMatrixAug cinfo -> CMSet cinfo -> CMSet cinfo
insert CallMatrixAug cinfo
a (CMSet Favorites (CallMatrixAug cinfo)
as) = forall cinfo. Favorites (CallMatrixAug cinfo) -> CMSet cinfo
CMSet forall a b. (a -> b) -> a -> b
$ forall a. PartialOrd a => a -> Favorites a -> Favorites a
Fav.insert CallMatrixAug cinfo
a Favorites (CallMatrixAug cinfo)
as
union :: CMSet cinfo -> CMSet cinfo -> CMSet cinfo
union :: forall cinfo. CMSet cinfo -> CMSet cinfo -> CMSet cinfo
union = forall a. Monoid a => a -> a -> a
mappend
toList :: CMSet cinfo -> [CallMatrixAug cinfo]
toList :: forall cinfo. CMSet cinfo -> [CallMatrixAug cinfo]
toList (CMSet Favorites (CallMatrixAug cinfo)
as) = forall a. Favorites a -> [a]
Fav.toList Favorites (CallMatrixAug cinfo)
as
instance Pretty CallMatrix where
pretty :: CallMatrix -> Doc
pretty (CallMatrix Matrix ArgumentIndex Order
m) = forall a. Pretty a => a -> Doc
pretty Matrix ArgumentIndex Order
m
instance Pretty cinfo => Pretty (CallMatrixAug cinfo) where
pretty :: CallMatrixAug cinfo -> Doc
pretty (CallMatrixAug CallMatrix
m cinfo
cinfo) = forall a. Pretty a => a -> Doc
pretty cinfo
cinfo Doc -> Doc -> Doc
$$ forall a. Pretty a => a -> Doc
pretty CallMatrix
m
instance Pretty cinfo => Pretty (CMSet cinfo) where
pretty :: CMSet cinfo -> Doc
pretty = forall (t :: * -> *). Foldable t => t Doc -> Doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *). Foldable t => Doc -> t Doc -> [Doc]
punctuate Doc
newLine forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall cinfo. CMSet cinfo -> [CallMatrixAug cinfo]
toList
where newLine :: Doc
newLine = Doc
"\n"