semirings 0.5.4 → 0.7
raw patch · 9 files changed
Files
- CHANGELOG.md +17/−0
- Data/Euclidean.hs +96/−68
- Data/Ring/Ordered.hs +223/−0
- Data/Semiring.hs +498/−160
- Data/Semiring/Directed.hs +60/−0
- Data/Semiring/Generic.hs +0/−51
- Data/Semiring/Tropical.hs +3/−10
- Data/Star.hs +0/−3
- semirings.cabal +22/−29
CHANGELOG.md view
@@ -1,3 +1,20 @@+0.7: [2024-05-21]+-----------------+* Add `Data.Semiring.Directed` for the semiring of directed sets.+* Add `Data.Ring.Ordered` to represent ordered rings (as well as a simpler+ finitary case) and provide `signum` and `abs` via type class.+* Modify code and CI to support GHC 8.0 and later only.+* Support newer versions of dependencies+* Move Generics-derived tuple instances from Data.Semiring.Generic to manually-written Data.Semiring++0.6: [2021-01-07]+-----------------+* Remove hashable flag (only necessary was unordered-containers flag)+* Drop redundant `Eq` constraint on default definition of `coprime`+* Document (lack of guaranteed) rounding behaviour of quotRem+* Fix totally broken Ord instance for Tropical+* Stop depending on integer-gmp+ 0.5.4: [2020.07.13] ------------------- * Drop support for GHCs prior to 7.10
Data/Euclidean.hs view
@@ -9,6 +9,12 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE MagicHash #-}+#if MIN_VERSION_base(4,12,0)+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE StandaloneDeriving #-}+#else+{-# LANGUAGE TemplateHaskell #-}+#endif module Data.Euclidean ( Euclidean(..)@@ -30,9 +36,11 @@ import Data.Semiring (Semiring(..), Ring(..), (*), minus, isZero, Mod2) import Data.Word (Word, Word8, Word16, Word32, Word64) import Foreign.C.Types (CFloat, CDouble)-import GHC.Exts (Int(..), Word(..))-import GHC.Integer.GMP.Internals (gcdInt, gcdWord, gcdInteger, lcmInteger) +#if !MIN_VERSION_base(4,12,0)+import Language.Haskell.TH.Syntax (Q, Dec, Type)+#endif+ import Numeric.Natural ---------------------------------------------------------------------@@ -101,7 +109,7 @@ -- prop> \x y -> coprime x y == isJust (1 `divide` gcd x y) coprime :: a -> a -> Bool - default coprime :: Eq a => a -> a -> Bool+ default coprime :: a -> a -> Bool coprime x y = isJust (one `divide` gcd x y) infixl 7 `divide`@@ -114,6 +122,12 @@ -- 'Euclidean' represents a -- <https://en.wikipedia.org/wiki/Euclidean_domain Euclidean domain> -- endowed by a given Euclidean function 'degree'.+--+-- No particular rounding behaviour is expected of 'quotRem'. E. g.,+-- it is not guaranteed to truncate towards zero or towards negative+-- infinity (cf. 'P.divMod'), and remainders are not guaranteed to be non-negative.+-- For a faithful representation of residue classes one can use+-- <http://hackage.haskell.org/package/mod mod> package instead. class GcdDomain a => Euclidean a where {-# MINIMAL (quotRem | quot, rem), degree #-} -- | Division with remainder.@@ -221,71 +235,6 @@ quot = P.quot rem = P.rem -instance GcdDomain Int where- divide x y = case x `P.quotRem` y of (q, 0) -> Just q; _ -> Nothing-#if MIN_VERSION_integer_gmp(0,5,1)- gcd (I# x) (I# y) = I# (gcdInt x y)-#else- gcd = P.gcd-#endif- lcm = P.lcm- coprime = coprimeIntegral--instance GcdDomain Word where- divide x y = case x `P.quotRem` y of (q, 0) -> Just q; _ -> Nothing-#if MIN_VERSION_integer_gmp(1,0,0)- gcd (W# x) (W# y) = W# (gcdWord x y)-#else- gcd = P.gcd-#endif- lcm = P.lcm- coprime = coprimeIntegral--instance GcdDomain Integer where- divide x y = case x `P.quotRem` y of (q, 0) -> Just q; _ -> Nothing- gcd = gcdInteger- lcm = lcmInteger- coprime = coprimeIntegral--#define deriveGcdDomain(ty) \-instance GcdDomain (ty) where { \-; divide x y = case x `P.quotRem` y of { (q, 0) -> Just q; _ -> Nothing } \-; gcd = P.gcd \-; lcm = P.lcm \-; coprime = coprimeIntegral \-}--deriveGcdDomain(Int8)-deriveGcdDomain(Int16)-deriveGcdDomain(Int32)-deriveGcdDomain(Int64)-deriveGcdDomain(Word8)-deriveGcdDomain(Word16)-deriveGcdDomain(Word32)-deriveGcdDomain(Word64)-deriveGcdDomain(Natural)--#define deriveEuclidean(ty) \-instance Euclidean (ty) where { \-; degree = P.fromIntegral . abs \-; quotRem = P.quotRem \-; quot = P.quot \-; rem = P.rem \-}--deriveEuclidean(Int)-deriveEuclidean(Int8)-deriveEuclidean(Int16)-deriveEuclidean(Int32)-deriveEuclidean(Int64)-deriveEuclidean(Integer)-deriveEuclidean(Word)-deriveEuclidean(Word8)-deriveEuclidean(Word16)-deriveEuclidean(Word32)-deriveEuclidean(Word64)-deriveEuclidean(Natural)- -- | Wrapper around 'Fractional' -- with trivial 'GcdDomain' -- and 'Euclidean' instances.@@ -404,3 +353,82 @@ rem = const $ const zero instance Field a => Field (Complex a)++#if MIN_VERSION_base(4,12,0)+deriving via (WrappedIntegral Int) instance GcdDomain Int+deriving via (WrappedIntegral Int8) instance GcdDomain Int8+deriving via (WrappedIntegral Int16) instance GcdDomain Int16+deriving via (WrappedIntegral Int32) instance GcdDomain Int32+deriving via (WrappedIntegral Int64) instance GcdDomain Int64+deriving via (WrappedIntegral Integer) instance GcdDomain Integer+deriving via (WrappedIntegral Word) instance GcdDomain Word+deriving via (WrappedIntegral Word8) instance GcdDomain Word8+deriving via (WrappedIntegral Word16) instance GcdDomain Word16+deriving via (WrappedIntegral Word32) instance GcdDomain Word32+deriving via (WrappedIntegral Word64) instance GcdDomain Word64+deriving via (WrappedIntegral Natural) instance GcdDomain Natural+#else+$(let+ deriveGcdDomain :: Q Type -> Q [Dec]+ deriveGcdDomain ty = [d|+ instance GcdDomain $ty where+ gcd = P.gcd+ lcm = P.lcm+ coprime = coprimeIntegral+ |]++ in P.concat P.<$> P.traverse deriveGcdDomain+ [[t|Int|]+ ,[t|Int8|]+ ,[t|Int16|]+ ,[t|Int32|]+ ,[t|Int64|]+ ,[t|Integer|]+ ,[t|Word|]+ ,[t|Word8|]+ ,[t|Word16|]+ ,[t|Word32|]+ ,[t|Word64|]+ ,[t|Natural|]+ ])+#endif++#if MIN_VERSION_base(4,12,0)+deriving via (WrappedIntegral Int) instance Euclidean Int+deriving via (WrappedIntegral Int8) instance Euclidean Int8+deriving via (WrappedIntegral Int16) instance Euclidean Int16+deriving via (WrappedIntegral Int32) instance Euclidean Int32+deriving via (WrappedIntegral Int64) instance Euclidean Int64+deriving via (WrappedIntegral Integer) instance Euclidean Integer+deriving via (WrappedIntegral Word) instance Euclidean Word+deriving via (WrappedIntegral Word8) instance Euclidean Word8+deriving via (WrappedIntegral Word16) instance Euclidean Word16+deriving via (WrappedIntegral Word32) instance Euclidean Word32+deriving via (WrappedIntegral Word64) instance Euclidean Word64+deriving via (WrappedIntegral Natural) instance Euclidean Natural+#else+$(let+ deriveEuclidean :: Q Type -> Q [Dec]+ deriveEuclidean ty = [d|+ instance Euclidean $ty where+ degree = P.fromIntegral . abs+ quotRem = P.quotRem+ quot = P.quot+ rem = P.rem+ |]++ in P.concat P.<$> P.traverse deriveEuclidean+ [[t|Int|]+ ,[t|Int8|]+ ,[t|Int16|]+ ,[t|Int32|]+ ,[t|Int64|]+ ,[t|Integer|]+ ,[t|Word|]+ ,[t|Word8|]+ ,[t|Word16|]+ ,[t|Word32|]+ ,[t|Word64|]+ ,[t|Natural|]+ ])+#endif
+ Data/Ring/Ordered.hs view
@@ -0,0 +1,223 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE Trustworthy #-}++-- |+-- Module: Data.Ring.Ordered+-- Copyright: (C) 2021 Koz Ross+-- License: BSD3 +-- Maintainer: Koz Ross <koz.ross@retro-freedom.nz>+-- Stability: stable+-- Portability: GHC only+--+-- An \'ordered ring\' is a ring with a total order.+--+-- = Mathematical pedantry note+--+-- Many (if not most) of the instances of the 'OrderedRing' type class are not+-- truly ordered rings in the mathematical sense, as the+-- [axioms](https://en.wikipedia.org/wiki/Ordered_ring) imply that the+-- underlying set is either a singleton or infinite. Thus, the [additional+-- properties](https://en.wikipedia.org/wiki/Ordered_ring#Basic_properties) of+-- ordered rings do not, in general, hold. +--+-- We indicate those instances that /are/ \'truly\' or \'mathematically\'+-- ordered rings in their documentation.+module Data.Ring.Ordered + (+ -- * Helper types+ Modular(..),+ -- * Ordered ring type class+ OrderedRing(..),+ ) where++import Control.Applicative (Const (Const))+import Data.Data (Data)+import Data.Fixed (HasResolution, Fixed)+import Data.Functor.Identity (Identity (Identity))+import Data.Int (Int8, Int16, Int32, Int64)+import Data.Monoid (Dual (Dual))+import Data.Ord (Down (Down))+import Data.Ratio (Ratio)+import Data.Semiring (Ring, Semiring(zero))+import Data.Word (Word8, Word16, Word32, Word64)+import GHC.Generics (Generic)+import Prelude hiding (signum, abs, negate, (-))+import qualified Prelude as Num+import Data.Typeable (Typeable)++-- | A wrapper to indicate the type is being treated as a [modular arithmetic+-- system](https://en.wikipedia.org/wiki/Modular_arithmetic) whose modulus is+-- the type's cardinality.+--+-- While we cannot guarantee that infinite types won't be wrapped by this, we+-- only provide instances of the relevant type classes for those types we are+-- certain are finite.+--+-- @since 0.7+newtype Modular a = Modular { getModular :: a }+ deriving+ ( Bounded -- ^ @since 0.7+ , Eq -- ^ @since 0.7+ , Ord -- ^ @since 0.7+ , Show -- ^ @since 0.7+ , Read -- ^ @since 0.7+ , Generic -- ^ @since 0.7+ , Data -- ^ @since 0.7+ , Typeable -- ^ @since 0.7+ )++-- @since 0.7+deriving instance Semiring (Modular Word8)++-- @since 0.7+deriving instance Semiring (Modular Word16)++-- @since 0.7+deriving instance Semiring (Modular Word32)++-- @since 0.7+deriving instance Semiring (Modular Word64)++-- @since 0.7+deriving instance Semiring (Modular Word)++-- @since 0.7+deriving instance Ring (Modular Word8)++-- @since 0.7+deriving instance Ring (Modular Word16)++-- @since 0.7+deriving instance Ring (Modular Word32)++-- @since 0.7+deriving instance Ring (Modular Word64)++-- @since 0.7+deriving instance Ring (Modular Word)++-- | The class of rings which also have a total order.+--+-- Instance should satisfy the following laws:+--+-- * @'abs' 'zero' = 'zero'@+-- * @'abs' x = 'abs' ('negate' x)@+-- * @x 'Data.Semiring.-' 'abs' x = 'zero'@+-- * @'signum' 'zero' = 'zero'@+-- * If @x '>' 'zero'@, then @'signum' x = 'one'@+-- * If @x '<' 'zero'@, then @'signum' x = 'negate' 'one'@+--+-- @since 0.7+class (Ring a, Ord a) => OrderedRing a where+ -- | Compute the absolute value.+ abs :: a -> a+ -- | Determine the \'sign\' of a value.+ signum :: a -> a++-- | This instance is a \'true\' or \'mathematical\' ordered ring, as it is a+-- singleton. We assume that '()' has a zero signum.+--+-- @since 0.7+instance OrderedRing () where+ abs = const ()+ signum = const zero++-- | Where @a@ is a \'true\' or \'mathematical\' ordered ring, so is this.+--+-- @since 0.7+instance (OrderedRing a) => OrderedRing (Dual a) where+ abs (Dual x) = Dual . abs $ x+ signum (Dual x) = Dual . signum $ x++-- | Where @a@ is a \'true\' or \'mathematical\' ordered ring, so is this.+--+-- @since 0.7+instance (OrderedRing a) => OrderedRing (Const a b) where+ abs (Const x) = Const . abs $ x+ signum (Const x) = Const . signum $ x++-- | Where @a ~ 'Integer'@, this instance is a \'true\' or \'mathematical\'+-- ordered ring, as the resulting type is infinite.+--+-- @since 0.7+instance (Integral a) => OrderedRing (Ratio a) where+ abs = Num.abs+ signum = Num.signum++-- | Where @a@ is a \'true\' or \'mathematical\' ordered ring, so is this.+--+-- @since 0.7+deriving instance (OrderedRing a) => OrderedRing (Down a)++-- | Where @a@ is a \'true\' or \'mathematical\' ordered ring, so is this.+--+-- @since 0.7+deriving instance (OrderedRing a) => OrderedRing (Identity a)++-- | @since 0.7+instance (HasResolution a) => OrderedRing (Fixed a) where+ abs = Num.abs+ signum = Num.signum++-- | @since 0.7+instance OrderedRing Int8 where+ abs = Num.abs+ signum = Num.signum++-- | @since 0.7+instance OrderedRing Int16 where+ abs = Num.abs+ signum = Num.signum++-- | @since 0.7+instance OrderedRing Int32 where+ abs = Num.abs+ signum = Num.signum++-- | @since 0.7+instance OrderedRing Int64 where+ abs = Num.abs+ signum = Num.signum++-- | @since 0.7+instance OrderedRing Int where+ abs = Num.abs+ signum = Num.signum++-- | This instance is a \'true\' or \'mathematical\' ordered ring, as 'Integer'+-- is an infinite type.+--+-- @since 0.7+instance OrderedRing Integer where+ abs = Num.abs+ signum = Num.signum++-- | @since 0.7+instance OrderedRing (Modular Word8) where+ abs x = x+ signum (Modular x) = Modular . Num.signum $ x++-- | @since 0.7+instance OrderedRing (Modular Word16) where+ abs x = x+ signum (Modular x) = Modular . Num.signum $ x++-- | @since 0.7+instance OrderedRing (Modular Word32) where+ abs x = x+ signum (Modular x) = Modular . Num.signum $ x++-- | @since 0.7+instance OrderedRing (Modular Word64) where+ abs x = x+ signum (Modular x) = Modular . Num.signum $ x++-- | @since 0.7+instance OrderedRing (Modular Word) where+ abs x = x+ signum (Modular x) = Modular . Num.signum $ x
Data/Semiring.hs view
@@ -11,6 +11,11 @@ {-# LANGUAGE Rank2Types #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE StandaloneDeriving #-}+#if MIN_VERSION_base(4,12,0)+{-# LANGUAGE DerivingVia #-}+#else+{-# LANGUAGE TemplateHaskell #-}+#endif ----------------------------------------------------------------------------- -- |@@ -52,7 +57,7 @@ ) where import Control.Applicative (Applicative(..), Const(..), liftA2)-import Data.Bits (Bits)+import Data.Bits (Bits (xor)) import Data.Bool (Bool(..), (||), (&&), otherwise) import Data.Coerce (Coercible, coerce) import Data.Complex (Complex(..))@@ -82,12 +87,10 @@ import Data.Monoid (Ap(..)) #endif #if defined(VERSION_containers)-#if MIN_VERSION_base(4,7,0) import Data.IntMap (IntMap) import qualified Data.IntMap as IntMap import Data.IntSet (IntSet) import qualified Data.IntSet as IntSet-#endif import Data.Map (Map) import qualified Data.Map as Map #endif@@ -96,7 +99,7 @@ import Data.Ord (Down(..)) import Data.Proxy (Proxy(..)) import Data.Ratio (Ratio, Rational, (%))-import Data.Semigroup.Compat (Semigroup(..))+import Data.Semigroup (Semigroup ((<>), stimes)) #if defined(VERSION_containers) import Data.Set (Set) import qualified Data.Set as Set@@ -118,26 +121,61 @@ import GHC.Float (Float, Double) import GHC.Generics (Generic,Generic1) import GHC.IO (IO)-import GHC.Integer (Integer) import qualified GHC.Num as Num import GHC.Read (Read) import GHC.Real (Integral, Fractional, Real, RealFrac) import qualified GHC.Real as Real import GHC.Show (Show) import Numeric.Natural (Natural)+import Prelude (Integer, Ordering(..), compare, even, quot) -#ifdef mingw32_HOST_OS-#define HOST_OS_WINDOWS 1-#else-#define HOST_OS_WINDOWS 0+#if !MIN_VERSION_base(4,12,0)+import Language.Haskell.TH.Syntax (Q, Dec, Type)+import qualified Prelude as P #endif -#if !HOST_OS_WINDOWS-import System.Posix.Types- (CCc, CDev, CGid, CIno, CMode, CNlink,- COff, CPid, CRLim, CSpeed, CSsize,- CTcflag, CUid, Fd)+#include "HsBaseConfig.h"+import System.Posix.Types (+#ifdef HTYPE_CC_T+ CCc(..), #endif+#ifdef HTYPE_DEV_T+ CDev(..),+#endif+#ifdef HTYPE_GID_T+ CGid(..),+#endif+#ifdef HTYPE_INO_T+ CIno(..),+#endif+#ifdef HTYPE_MODE_T+ CMode(..),+#endif+#ifdef HTYPE_NLINK_T+ CNlink(..),+#endif+#ifdef HTYPE_OFF_T+ COff(..),+#endif+#ifdef HTYPE_PID_T+ CPid(..),+#endif+#ifdef HTYPE_RLIM_T+ CRLim(..),+#endif+#ifdef HTYPE_SPEED_T+ CSpeed(..),+#endif+#ifdef HTYPE_SSIZE_T+ CSsize(..),+#endif+#ifdef HTYPE_TCFLAG_T+ CTcflag(..),+#endif+#ifdef HTYPE_UID_T+ CUid(..),+#endif+ Fd(..)) infixl 7 *, `times` infixl 6 +, `plus`, -, `minus`@@ -327,6 +365,20 @@ instance Semiring a => Semigroup (Mul a) where Mul a <> Mul b = Mul (a * b) {-# INLINE (<>) #-}+ stimes n x0 = case compare n 0 of+ LT -> error "stimes: negative multiplier"+ EQ -> mempty+ GT -> f x0 n+ where+ f x y+ | even y = f (x `mappend` x) (y `quot` 2)+ | y == 1 = x+ | otherwise = g (x `mappend` x) (y `quot` 2) x+ g x y z+ | even y = g (x `mappend` x) (y `quot` 2) z+ | y == 1 = x `mappend` z+ | otherwise = g (x `mappend` x) (y `quot` 2) (x `mappend` z)+ {-# INLINE stimes #-} instance Semiring a => Monoid (Mul a) where mempty = Mul one@@ -382,10 +434,7 @@ ) instance Semiring Mod2 where- -- we inline the definition of 'xor'- -- on Bools, since the instance did not exist until- -- base-4.7.0.- plus (Mod2 x) (Mod2 y) = Mod2 (x /= y)+ plus (Mod2 x) (Mod2 y) = Mod2 (x `xor` y) times (Mod2 x) (Mod2 y) = Mod2 (x && y) zero = Mod2 False one = Mod2 True@@ -439,9 +488,7 @@ -- @'zero' '*' x = x '*' 'zero' = 'zero'@ class Semiring a where-#if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL plus, times, (zero, one | fromNatural) #-}-#endif plus :: a -> a -> a -- ^ Commutative Operation zero :: a -- ^ Commutative Unit zero = fromNatural 0@@ -457,9 +504,7 @@ -- @'negate' a '+' a = 'zero'@ class Semiring a => Ring a where-#if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL negate #-}-#endif negate :: a -> a -- | Subtract two 'Ring' values. For any type @R@ with@@ -494,6 +539,72 @@ Instances (base) --------------------------------------------------------------------} +instance (Semiring a, Semiring b) => Semiring (a,b) where+ zero = (zero, zero)+ one = (one, one)+ plus (x1, x2) (y1, y2) =+ (x1 `plus` y1, x2 `plus` y2)+ times (x1, x2) (y1, y2) =+ (x1 `times` y1, x2 `times` y2)++instance (Semiring a, Semiring b, Semiring c) => Semiring (a,b,c) where+ zero = (zero, zero, zero)+ one = (one, one, one)+ plus (x1, x2, x3) (y1, y2, y3) =+ (x1 `plus` y1, x2 `plus` y2, x3 `plus` y3)+ times (x1, x2, x3) (y1, y2, y3) =+ (x1 `times` y1, x2 `times` y2, x3 `times` y3)++instance (Semiring a, Semiring b, Semiring c, Semiring d) => Semiring (a,b,c,d) where+ zero = (zero, zero, zero, zero)+ one = (one, one, one, one)+ plus (x1, x2, x3, x4) (y1, y2, y3, y4) =+ (x1 `plus` y1, x2 `plus` y2, x3 `plus` y3, x4 `plus` y4)+ times (x1, x2, x3, x4) (y1, y2, y3, y4) =+ (x1 `times` y1, x2 `times` y2, x3 `times` y3, x4 `times` y4)++instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e) => Semiring (a,b,c,d,e) where+ zero = (zero, zero, zero, zero, zero)+ one = (one, one, one, one, one)+ plus (x1, x2, x3, x4, x5) (y1, y2, y3, y4, y5) =+ (x1 `plus` y1, x2 `plus` y2, x3 `plus` y3, x4 `plus` y4, x5 `plus` y5)+ times (x1, x2, x3, x4, x5) (y1, y2, y3, y4, y5) =+ (x1 `times` y1, x2 `times` y2, x3 `times` y3, x4 `times` y4, x5 `times` y5)++instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f) => Semiring (a,b,c,d,e,f) where+ zero = (zero, zero, zero, zero, zero, zero)+ one = (one, one, one, one, one, one)+ plus (x1, x2, x3, x4, x5, x6) (y1, y2, y3, y4, y5, y6) =+ (x1 `plus` y1, x2 `plus` y2, x3 `plus` y3, x4 `plus` y4, x5 `plus` y5, x6 `plus` y6)+ times (x1, x2, x3, x4, x5, x6) (y1, y2, y3, y4, y5, y6) =+ (x1 `times` y1, x2 `times` y2, x3 `times` y3, x4 `times` y4, x5 `times` y5, x6 `times` y6)++instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f, Semiring g) => Semiring (a,b,c,d,e,f,g) where+ zero = (zero, zero, zero, zero, zero, zero, zero)+ one = (one, one, one, one, one, one, one)+ plus (x1, x2, x3, x4, x5, x6, x7) (y1, y2, y3, y4, y5, y6, y7) =+ (x1 `plus` y1, x2 `plus` y2, x3 `plus` y3, x4 `plus` y4, x5 `plus` y5, x6 `plus` y6, x7 `plus` y7)+ times (x1, x2, x3, x4, x5, x6, x7) (y1, y2, y3, y4, y5, y6, y7) =+ (x1 `times` y1, x2 `times` y2, x3 `times` y3, x4 `times` y4, x5 `times` y5, x6 `times` y6, x7 `times` y7)++instance (Ring a, Ring b) => Ring (a,b) where+ negate (x1, x2) = (negate x1, negate x2)++instance (Ring a, Ring b, Ring c) => Ring (a,b,c) where+ negate (x1, x2, x3) = (negate x1, negate x2, negate x3)++instance (Ring a, Ring b, Ring c, Ring d) => Ring (a,b,c,d) where+ negate (x1, x2, x3, x4) = (negate x1, negate x2, negate x3, negate x4)++instance (Ring a, Ring b, Ring c, Ring d, Ring e) => Ring (a,b,c,d,e) where+ negate (x1, x2, x3, x4, x5) = (negate x1, negate x2, negate x3, negate x4, negate x5)++instance (Ring a, Ring b, Ring c, Ring d, Ring e, Ring f) => Ring (a,b,c,d,e,f) where+ negate (x1, x2, x3, x4, x5, x6) = (negate x1, negate x2, negate x3, negate x4, negate x5, negate x6)++instance (Ring a, Ring b, Ring c, Ring d, Ring e, Ring f, Ring g) => Ring (a,b,c,d,e,f,g) where+ negate (x1, x2, x3, x4, x5, x6, x7) = (negate x1, negate x2, negate x3, negate x4, negate x5, negate x6, negate x7)+ instance Semiring b => Semiring (a -> b) where plus f g = \x -> f x `plus` g x zero = const zero@@ -664,80 +775,6 @@ deriving instance Ring a => Ring (Op a b) #endif -#define deriveSemiring(ty) \-instance Semiring (ty) where { \- zero = 0 \-; one = 1 \-; plus x y = (Num.+) x y \-; times x y = (Num.*) x y \-; fromNatural = Real.fromIntegral \-; {-# INLINE zero #-} \-; {-# INLINE one #-} \-; {-# INLINE plus #-} \-; {-# INLINE times #-} \-; {-# INLINE fromNatural #-} \-}--deriveSemiring(Int)-deriveSemiring(Int8)-deriveSemiring(Int16)-deriveSemiring(Int32)-deriveSemiring(Int64)-deriveSemiring(Integer)-deriveSemiring(Word)-deriveSemiring(Word8)-deriveSemiring(Word16)-deriveSemiring(Word32)-deriveSemiring(Word64)-deriveSemiring(Float)-deriveSemiring(Double)-deriveSemiring(CUIntMax)-deriveSemiring(CIntMax)-deriveSemiring(CUIntPtr)-deriveSemiring(CIntPtr)-deriveSemiring(CSUSeconds)-deriveSemiring(CUSeconds)-deriveSemiring(CTime)-deriveSemiring(CClock)-deriveSemiring(CSigAtomic)-deriveSemiring(CWchar)-deriveSemiring(CSize)-deriveSemiring(CPtrdiff)-deriveSemiring(CDouble)-deriveSemiring(CFloat)-deriveSemiring(CULLong)-deriveSemiring(CLLong)-deriveSemiring(CULong)-deriveSemiring(CLong)-deriveSemiring(CUInt)-deriveSemiring(CInt)-deriveSemiring(CUShort)-deriveSemiring(CShort)-deriveSemiring(CUChar)-deriveSemiring(CSChar)-deriveSemiring(CChar)-deriveSemiring(IntPtr)-deriveSemiring(WordPtr)--#if !HOST_OS_WINDOWS-deriveSemiring(CCc)-deriveSemiring(CDev)-deriveSemiring(CGid)-deriveSemiring(CIno)-deriveSemiring(CMode)-deriveSemiring(CNlink)-deriveSemiring(COff)-deriveSemiring(CPid)-deriveSemiring(CRLim)-deriveSemiring(CSpeed)-deriveSemiring(CSsize)-deriveSemiring(CTcflag)-deriveSemiring(CUid)-deriveSemiring(Fd)-#endif--deriveSemiring(Natural)- instance Integral a => Semiring (Ratio a) where {-# SPECIALIZE instance Semiring Rational #-} zero = 0 % 1@@ -764,70 +801,6 @@ {-# INLINE times #-} {-# INLINE fromNatural #-} -#define deriveRing(ty) \-instance Ring (ty) where { \- negate = Num.negate \-; {-# INLINE negate #-} \-}--deriveRing(Int)-deriveRing(Int8)-deriveRing(Int16)-deriveRing(Int32)-deriveRing(Int64)-deriveRing(Integer)-deriveRing(Word)-deriveRing(Word8)-deriveRing(Word16)-deriveRing(Word32)-deriveRing(Word64)-deriveRing(Float)-deriveRing(Double)-deriveRing(CUIntMax)-deriveRing(CIntMax)-deriveRing(CUIntPtr)-deriveRing(CIntPtr)-deriveRing(CSUSeconds)-deriveRing(CUSeconds)-deriveRing(CTime)-deriveRing(CClock)-deriveRing(CSigAtomic)-deriveRing(CWchar)-deriveRing(CSize)-deriveRing(CPtrdiff)-deriveRing(CDouble)-deriveRing(CFloat)-deriveRing(CULLong)-deriveRing(CLLong)-deriveRing(CULong)-deriveRing(CLong)-deriveRing(CUInt)-deriveRing(CInt)-deriveRing(CUShort)-deriveRing(CShort)-deriveRing(CUChar)-deriveRing(CSChar)-deriveRing(CChar)-deriveRing(IntPtr)-deriveRing(WordPtr)--#if !HOST_OS_WINDOWS-deriveRing(CCc)-deriveRing(CDev)-deriveRing(CGid)-deriveRing(CIno)-deriveRing(CMode)-deriveRing(CNlink)-deriveRing(COff)-deriveRing(CPid)-deriveRing(CRLim)-deriveRing(CSpeed)-deriveRing(CSsize)-deriveRing(CTcflag)-deriveRing(CUid)-deriveRing(Fd)-#endif- instance Integral a => Ring (Ratio a) where negate = Num.negate {-# INLINE negate #-}@@ -1012,3 +985,368 @@ isOne :: (Eq a, Semiring a) => a -> Bool isOne x = x == one {-# INLINEABLE isOne #-}++#if MIN_VERSION_base(4,12,0)+deriving via (WrappedNum Int) instance Semiring Int+deriving via (WrappedNum Int8) instance Semiring Int8+deriving via (WrappedNum Int16) instance Semiring Int16+deriving via (WrappedNum Int32) instance Semiring Int32+deriving via (WrappedNum Int64) instance Semiring Int64+deriving via (WrappedNum Integer) instance Semiring Integer+deriving via (WrappedNum Word) instance Semiring Word+deriving via (WrappedNum Word8) instance Semiring Word8+deriving via (WrappedNum Word16) instance Semiring Word16+deriving via (WrappedNum Word32) instance Semiring Word32+deriving via (WrappedNum Word64) instance Semiring Word64+deriving via (WrappedNum Float) instance Semiring Float+deriving via (WrappedNum Double) instance Semiring Double+deriving via (WrappedNum CUIntMax) instance Semiring CUIntMax+deriving via (WrappedNum CIntMax) instance Semiring CIntMax+deriving via (WrappedNum CUIntPtr) instance Semiring CUIntPtr+deriving via (WrappedNum CIntPtr) instance Semiring CIntPtr+deriving via (WrappedNum CSUSeconds) instance Semiring CSUSeconds+deriving via (WrappedNum CUSeconds) instance Semiring CUSeconds+deriving via (WrappedNum CTime) instance Semiring CTime+deriving via (WrappedNum CClock) instance Semiring CClock+deriving via (WrappedNum CSigAtomic) instance Semiring CSigAtomic+deriving via (WrappedNum CWchar) instance Semiring CWchar+deriving via (WrappedNum CSize) instance Semiring CSize+deriving via (WrappedNum CPtrdiff) instance Semiring CPtrdiff+deriving via (WrappedNum CDouble) instance Semiring CDouble+deriving via (WrappedNum CFloat) instance Semiring CFloat+deriving via (WrappedNum CULLong) instance Semiring CULLong+deriving via (WrappedNum CLLong) instance Semiring CLLong+deriving via (WrappedNum CULong) instance Semiring CULong+deriving via (WrappedNum CLong) instance Semiring CLong+deriving via (WrappedNum CUInt) instance Semiring CUInt+deriving via (WrappedNum CInt) instance Semiring CInt+deriving via (WrappedNum CUShort) instance Semiring CUShort+deriving via (WrappedNum CShort) instance Semiring CShort+deriving via (WrappedNum CUChar) instance Semiring CUChar+deriving via (WrappedNum CSChar) instance Semiring CSChar+deriving via (WrappedNum CChar) instance Semiring CChar+deriving via (WrappedNum IntPtr) instance Semiring IntPtr+deriving via (WrappedNum WordPtr) instance Semiring WordPtr++#ifdef HTYPE_CC_T+deriving via (WrappedNum CCc) instance Semiring CCc+#endif+#ifdef HTYPE_DEV_T+deriving via (WrappedNum CDev) instance Semiring CDev+#endif+#ifdef HTYPE_GID_T+deriving via (WrappedNum CGid) instance Semiring CGid+#endif+#ifdef HTYPE_INO_T+deriving via (WrappedNum CIno) instance Semiring CIno+#endif+#ifdef HTYPE_MODE_T+deriving via (WrappedNum CMode) instance Semiring CMode+#endif+#ifdef HTYPE_NLINK_T+deriving via (WrappedNum CNlink) instance Semiring CNlink+#endif+#ifdef HTYPE_OFF_T+deriving via (WrappedNum COff) instance Semiring COff+#endif+#ifdef HTYPE_PID_T+deriving via (WrappedNum CPid) instance Semiring CPid+#endif+#ifdef HTYPE_RLIM_T+deriving via (WrappedNum CRLim) instance Semiring CRLim+#endif+#ifdef HTYPE_SPEED_T+deriving via (WrappedNum CSpeed) instance Semiring CSpeed+#endif+#ifdef HTYPE_SSIZE_T+deriving via (WrappedNum CSsize) instance Semiring CSsize+#endif+#ifdef HTYPE_TCFLAG_T+deriving via (WrappedNum CTcflag) instance Semiring CTcflag+#endif+#ifdef HTYPE_UID_T+deriving via (WrappedNum CUid) instance Semiring CUid+#endif+deriving via (WrappedNum Fd) instance Semiring Fd++deriving via (WrappedNum Natural) instance Semiring Natural+#else+-- Integral and fieldlike instances+$(let+ deriveSemiring :: Q Type -> Q [Dec]+ deriveSemiring ty = [d|+ instance Semiring $ty where+ zero = 0+ one = 1+ plus x y = (Num.+) x y+ times x y = (Num.*) x y+ fromNatural = Real.fromIntegral+ {-# INLINE zero #-}+ {-# INLINE one #-}+ {-# INLINE plus #-}+ {-# INLINE times #-}+ {-# INLINE fromNatural #-}+ |]++ in P.concat P.<$> P.traverse deriveSemiring+ [[t|Int|]+ ,[t|Int8|]+ ,[t|Int16|]+ ,[t|Int32|]+ ,[t|Int64|]+ ,[t|Integer|]+ ,[t|Word|]+ ,[t|Word8|]+ ,[t|Word16|]+ ,[t|Word32|]+ ,[t|Word64|]+ ,[t|Float|]+ ,[t|Double|]+ ,[t|CUIntMax|]+ ,[t|CIntMax|]+ ,[t|CUIntPtr|]+ ,[t|CIntPtr|]+ ,[t|CSUSeconds|]+ ,[t|CUSeconds|]+ ,[t|CTime|]+ ,[t|CClock|]+ ,[t|CSigAtomic|]+ ,[t|CWchar|]+ ,[t|CSize|]+ ,[t|CPtrdiff|]+ ,[t|CDouble|]+ ,[t|CFloat|]+ ,[t|CULLong|]+ ,[t|CLLong|]+ ,[t|CULong|]+ ,[t|CLong|]+ ,[t|CUInt|]+ ,[t|CInt|]+ ,[t|CUShort|]+ ,[t|CShort|]+ ,[t|CUChar|]+ ,[t|CSChar|]+ ,[t|CChar|]+ ,[t|IntPtr|]+ ,[t|WordPtr|]++#ifdef HTYPE_CC_T+ ,[t|CCc|]+#endif+#ifdef HTYPE_DEV_T+ ,[t|CDev|]+#endif+#ifdef HTYPE_GID_T+ ,[t|CGid|]+#endif+#ifdef HTYPE_INO_T+ ,[t|CIno|]+#endif+#ifdef HTYPE_MODE_T+ ,[t|CMode|]+#endif+#ifdef HTYPE_NLINK_T+ ,[t|CNlink|]+#endif+#ifdef HTYPE_OFF_T+ ,[t|COff|]+#endif+#ifdef HTYPE_PID_T+ ,[t|CPid|]+#endif+#ifdef HTYPE_RLIM_T+ ,[t|CRLim|]+#endif+#ifdef HTYPE_SPEED_T+ ,[t|CSpeed|]+#endif+#ifdef HTYPE_SSIZE_T+ ,[t|CSsize|]+#endif+#ifdef HTYPE_TCFLAG_T+ ,[t|CTcflag|]+#endif+#ifdef HTYPE_UID_T+ ,[t|CUid|]+#endif+ ,[t|Fd|]++ ,[t|Natural|]+ ])+#endif++#if MIN_VERSION_base(4,12,0)+deriving via (WrappedNum Int) instance Ring Int+deriving via (WrappedNum Int8) instance Ring Int8+deriving via (WrappedNum Int16) instance Ring Int16+deriving via (WrappedNum Int32) instance Ring Int32+deriving via (WrappedNum Int64) instance Ring Int64+deriving via (WrappedNum Integer) instance Ring Integer+deriving via (WrappedNum Word) instance Ring Word+deriving via (WrappedNum Word8) instance Ring Word8+deriving via (WrappedNum Word16) instance Ring Word16+deriving via (WrappedNum Word32) instance Ring Word32+deriving via (WrappedNum Word64) instance Ring Word64+deriving via (WrappedNum Float) instance Ring Float+deriving via (WrappedNum Double) instance Ring Double+deriving via (WrappedNum CUIntMax) instance Ring CUIntMax+deriving via (WrappedNum CIntMax) instance Ring CIntMax+deriving via (WrappedNum CUIntPtr) instance Ring CUIntPtr+deriving via (WrappedNum CIntPtr) instance Ring CIntPtr+deriving via (WrappedNum CSUSeconds) instance Ring CSUSeconds+deriving via (WrappedNum CUSeconds) instance Ring CUSeconds+deriving via (WrappedNum CTime) instance Ring CTime+deriving via (WrappedNum CClock) instance Ring CClock+deriving via (WrappedNum CSigAtomic) instance Ring CSigAtomic+deriving via (WrappedNum CWchar) instance Ring CWchar+deriving via (WrappedNum CSize) instance Ring CSize+deriving via (WrappedNum CPtrdiff) instance Ring CPtrdiff+deriving via (WrappedNum CDouble) instance Ring CDouble+deriving via (WrappedNum CFloat) instance Ring CFloat+deriving via (WrappedNum CULLong) instance Ring CULLong+deriving via (WrappedNum CLLong) instance Ring CLLong+deriving via (WrappedNum CULong) instance Ring CULong+deriving via (WrappedNum CLong) instance Ring CLong+deriving via (WrappedNum CUInt) instance Ring CUInt+deriving via (WrappedNum CInt) instance Ring CInt+deriving via (WrappedNum CUShort) instance Ring CUShort+deriving via (WrappedNum CShort) instance Ring CShort+deriving via (WrappedNum CUChar) instance Ring CUChar+deriving via (WrappedNum CSChar) instance Ring CSChar+deriving via (WrappedNum CChar) instance Ring CChar+deriving via (WrappedNum IntPtr) instance Ring IntPtr+deriving via (WrappedNum WordPtr) instance Ring WordPtr++#ifdef HTYPE_CC_T+deriving via (WrappedNum CCc) instance Ring CCc+#endif+#ifdef HTYPE_DEV_T+deriving via (WrappedNum CDev) instance Ring CDev+#endif+#ifdef HTYPE_GID_T+deriving via (WrappedNum CGid) instance Ring CGid+#endif+#ifdef HTYPE_INO_T+deriving via (WrappedNum CIno) instance Ring CIno+#endif+#ifdef HTYPE_MODE_T+deriving via (WrappedNum CMode) instance Ring CMode+#endif+#ifdef HTYPE_NLINK_T+deriving via (WrappedNum CNlink) instance Ring CNlink+#endif+#ifdef HTYPE_OFF_T+deriving via (WrappedNum COff) instance Ring COff+#endif+#ifdef HTYPE_PID_T+deriving via (WrappedNum CPid) instance Ring CPid+#endif+#ifdef HTYPE_RLIM_T+deriving via (WrappedNum CRLim) instance Ring CRLim+#endif+#ifdef HTYPE_SPEED_T+deriving via (WrappedNum CSpeed) instance Ring CSpeed+#endif+#ifdef HTYPE_SSIZE_T+deriving via (WrappedNum CSsize) instance Ring CSsize+#endif+#ifdef HTYPE_TCFLAG_T+deriving via (WrappedNum CTcflag) instance Ring CTcflag+#endif+#ifdef HTYPE_UID_T+deriving via (WrappedNum CUid) instance Ring CUid+#endif+deriving via (WrappedNum Fd) instance Ring Fd+#else+$(let+ deriveRing :: Q Type -> Q [Dec]+ deriveRing ty = [d|+ instance Ring $ty where+ negate = Num.negate+ {-# INLINE negate #-}+ |]++ in P.concat P.<$> P.traverse deriveRing+ [[t|Int|]+ ,[t|Int8|]+ ,[t|Int16|]+ ,[t|Int32|]+ ,[t|Int64|]+ ,[t|Integer|]+ ,[t|Word|]+ ,[t|Word8|]+ ,[t|Word16|]+ ,[t|Word32|]+ ,[t|Word64|]+ ,[t|Float|]+ ,[t|Double|]+ ,[t|CUIntMax|]+ ,[t|CIntMax|]+ ,[t|CUIntPtr|]+ ,[t|CIntPtr|]+ ,[t|CSUSeconds|]+ ,[t|CUSeconds|]+ ,[t|CTime|]+ ,[t|CClock|]+ ,[t|CSigAtomic|]+ ,[t|CWchar|]+ ,[t|CSize|]+ ,[t|CPtrdiff|]+ ,[t|CDouble|]+ ,[t|CFloat|]+ ,[t|CULLong|]+ ,[t|CLLong|]+ ,[t|CULong|]+ ,[t|CLong|]+ ,[t|CUInt|]+ ,[t|CInt|]+ ,[t|CUShort|]+ ,[t|CShort|]+ ,[t|CUChar|]+ ,[t|CSChar|]+ ,[t|CChar|]+ ,[t|IntPtr|]+ ,[t|WordPtr|]++#ifdef HTYPE_CC_T+ ,[t|CCc|]+#endif+#ifdef HTYPE_DEV_T+ ,[t|CDev|]+#endif+#ifdef HTYPE_GID_T+ ,[t|CGid|]+#endif+#ifdef HTYPE_INO_T+ ,[t|CIno|]+#endif+#ifdef HTYPE_MODE_T+ ,[t|CMode|]+#endif+#ifdef HTYPE_NLINK_T+ ,[t|CNlink|]+#endif+#ifdef HTYPE_OFF_T+ ,[t|COff|]+#endif+#ifdef HTYPE_PID_T+ ,[t|CPid|]+#endif+#ifdef HTYPE_RLIM_T+ ,[t|CRLim|]+#endif+#ifdef HTYPE_SPEED_T+ ,[t|CSpeed|]+#endif+#ifdef HTYPE_SSIZE_T+ ,[t|CSsize|]+#endif+#ifdef HTYPE_TCFLAG_T+ ,[t|CTcflag|]+#endif+#ifdef HTYPE_UID_T+ ,[t|CUid|]+#endif+ ,[t|Fd|]+ ])+#endif
+ Data/Semiring/Directed.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE Trustworthy #-}++-----------------------------------------------------------------------------+-- |+-- A "directed semiring" refers to the semiring composed of the union of upwards+-- directed sets as multiplication, and intersection of downwards directed sets+-- as addition.+-----------------------------------------------------------------------------+module Data.Semiring.Directed+ ( -- * Directed semirings+ Directed(..)+ ) where++import Data.Data (Data)+import Data.Coerce (coerce)+import Data.Semiring (Semiring(..))+import Data.Semigroup (Min(Min), Max(Max), (<>))+import Data.Typeable (Typeable)+import GHC.Generics (Generic)++-- | Wrapper for the semiring of upwards and downwards directed sets.+--+-- For the individual join/meet monoids associated with either+-- algebra, see @'Max' 'Ordering', and @'Min' 'Ordering'@.+newtype Directed = Directed { + -- | @since 0.7+ getDirected :: Ordering + }+ deriving ( + -- | @since 0.7+ Bounded, + -- | @since 0.7+ Enum,+ -- | @since 0.7+ Eq,+ -- | @since 0.7+ Generic,+ -- | @since 0.7+ Show,+ -- | @since 0.7+ Read,+ -- | @since 0.7+ Data,+ -- | @since 0.7+ Typeable + )++-- | @since 0.7+instance Semiring Directed where+ plus = coerce ((<>) :: Max Ordering -> Max Ordering -> Max Ordering)+ zero = coerce (mempty :: Max Ordering)+ times = coerce ((<>) :: Min Ordering -> Min Ordering -> Min Ordering)+ one = coerce (mempty :: Min Ordering)
Data/Semiring/Generic.hs view
@@ -1,15 +1,8 @@-{-# LANGUAGE CPP #-}-#if MIN_VERSION_base(4,6,0) {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-}-#endif --- below are safe orphan instances-{-# OPTIONS_GHC -fno-warn-orphans #-}-- ----------------------------------------------------------------------------- -- | -- Module : Data.Semiring.Generic@@ -27,7 +20,6 @@ module Data.Semiring.Generic (-#if MIN_VERSION_base(4,6,0) GSemiring(..) , gzero , gone@@ -37,10 +29,8 @@ , GRing(..) , gnegate , GenericSemiring(..)-#endif ) where -#if MIN_VERSION_base(4,6,0) import Data.Semiring import GHC.Generics import Numeric.Natural (Natural)@@ -58,42 +48,6 @@ times (GenericSemiring x) (GenericSemiring y) = GenericSemiring (gtimes x y) fromNatural x = GenericSemiring (gfromNatural x) -instance (Semiring a, Semiring b) => Semiring (a,b) where- zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;--instance (Semiring a, Semiring b, Semiring c) => Semiring (a,b,c) where- zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;--instance (Semiring a, Semiring b, Semiring c, Semiring d) => Semiring (a,b,c,d) where- zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;--instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e) => Semiring (a,b,c,d,e) where- zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;--instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f) => Semiring (a,b,c,d,e,f) where- zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;--instance (Semiring a, Semiring b, Semiring c, Semiring d, Semiring e, Semiring f, Semiring g) => Semiring (a,b,c,d,e,f,g) where- zero = gzero; one = gone; plus = gplus; times = gtimes; fromNatural = gfromNatural;--instance (Ring a, Ring b) => Ring (a,b) where- negate = gnegate--instance (Ring a, Ring b, Ring c) => Ring (a,b,c) where- negate = gnegate--instance (Ring a, Ring b, Ring c, Ring d) => Ring (a,b,c,d) where- negate = gnegate--instance (Ring a, Ring b, Ring c, Ring d, Ring e) => Ring (a,b,c,d,e) where- negate = gnegate--instance (Ring a, Ring b, Ring c, Ring d, Ring e, Ring f) => Ring (a,b,c,d,e,f) where- negate = gnegate--instance (Ring a, Ring b, Ring c, Ring d, Ring e, Ring f, Ring g) => Ring (a,b,c,d,e,f,g) where- negate = gnegate- {-------------------------------------------------------------------- Generics --------------------------------------------------------------------}@@ -101,9 +55,7 @@ -- | Generic 'Semiring' class, used to implement 'plus', 'times', 'zero', -- and 'one' for product-like types implementing 'Generic'. class GSemiring f where-#if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL gplus', gzero', gtimes', gone', gfromNatural' #-}-#endif gzero' :: f a gone' :: f a gplus' :: f a -> f a -> f a@@ -113,9 +65,7 @@ -- | Generic 'Ring' class, used to implement 'negate' for product-like -- types implementing 'Generic'. class GRing f where-#if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL gnegate' #-}-#endif gnegate' :: f a -> f a -- | Generically generate a 'Semiring' 'zero' for any product-like type@@ -214,4 +164,3 @@ instance (Ring a) => GRing (K1 i a) where gnegate' (K1 x) = K1 $ negate x-#endif
Data/Semiring/Tropical.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE KindSignatures #-}@@ -31,14 +30,10 @@ , EProxy(EProxy) ) where -#if MIN_VERSION_base(4,7,0) import Data.Data (Data)-#endif import Data.Semiring (Semiring(..)) import Data.Star (Star(..))-#if MIN_VERSION_base(4,7,0) import Data.Typeable (Typeable)-#endif -- done for haddocks, to make sure -Wall works import qualified Data.Monoid as Monoid@@ -94,20 +89,18 @@ ( Eq , Show , Read-#if MIN_VERSION_base(4,7,0) , Typeable , Data-#endif ) instance forall e a. (Ord a, Extremum e) => Ord (Tropical e a) where compare Infinity Infinity = EQ compare Infinity _ = case extremum (EProxy :: EProxy e) of- Minima -> LT- Maxima -> GT- compare _ Infinity = case extremum (EProxy :: EProxy e) of Minima -> GT Maxima -> LT+ compare _ Infinity = case extremum (EProxy :: EProxy e) of+ Minima -> LT+ Maxima -> GT compare (Tropical x) (Tropical y) = compare x y instance forall e a. (Ord a, Monoid.Monoid a, Extremum e) => Semiring (Tropical e a) where
Data/Star.hs view
@@ -1,4 +1,3 @@-{-# LANGUAGE CPP #-} {-# LANGUAGE NoImplicitPrelude #-} -----------------------------------------------------------------------------@@ -25,9 +24,7 @@ -- -- @'aplus' x = x '*' 'star' x@ class (Semiring a) => Star a where-#if __GLASGOW_HASKELL__ >= 708 {-# MINIMAL star | aplus #-}-#endif star :: a -> a star a = one `plus` aplus a
semirings.cabal view
@@ -1,6 +1,6 @@ name: semirings category: Algebra, Data, Data Structures, Math, Maths, Mathematics-version: 0.5.4+version: 0.7 license: BSD3 cabal-version: >= 1.10 license-file: LICENSE@@ -29,28 +29,22 @@ build-type: Simple extra-source-files: README.md CHANGELOG.md-tested-with: GHC == 7.10.3- , GHC == 8.0.2- , GHC == 8.2.2- , GHC == 8.4.4- , GHC == 8.6.5- , GHC == 8.8.3- , GHC == 8.10.1+tested-with:+ GHC == 8.0+ GHC == 8.2+ GHC == 8.4+ GHC == 8.6+ GHC == 8.8+ GHC == 8.10+ GHC == 9.0+ GHC == 9.2+ GHC == 9.4+ GHC == 9.6 source-repository head type: git location: git://github.com/chessai/semirings.git -flag hashable- description:- You can disable the use of the `hashable` package using `-f-hashable`.- .- Disabling this may be useful for accelerating builds in sandboxes for expert users.- .- Note: `-f-hashable` implies `-f-unordered-containers`, as we are necessarily not able to supply those instances as well.- default: True- manual: True- flag containers description: You can disable the use of the `containers` package using `-f-containers`.@@ -73,24 +67,23 @@ build-depends: base >= 4.8 && < 5- , base-compat-batteries- , integer-gmp >= 0.1.0.0 exposed-modules: Data.Euclidean Data.Field+ Data.Ring.Ordered Data.Semiring Data.Star+ Data.Semiring.Directed Data.Semiring.Tropical Data.Semiring.Generic - if flag(containers)- build-depends: containers >= 0.5.4 && < 0.7-- if flag(hashable)- build-depends: hashable >= 1.1 && < 1.4+ if impl(ghc < 8.6.1)+ build-depends: template-haskell >= 2.4.0.0 - if flag(hashable)- build-depends: hashable >= 1.1 && < 1.4+ if flag(containers)+ build-depends: containers >= 0.5.4 - if flag(hashable) && flag(unordered-containers)- build-depends: unordered-containers >= 0.2 && < 0.3+ if flag(unordered-containers)+ build-depends:+ hashable >= 1.1+ , unordered-containers >= 0.2