summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEdwardKmett <>2017-10-18 17:26:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2017-10-18 17:26:00 (GMT)
commit1c71e47faba2815d842335752e3ad40e4148298c (patch)
tree8a33872b8b07427b57a85e0908e6236dfc2a741d
parent1a9301ece56874f8ed40dfa56def2f512df3f681 (diff)
version 0.12HEAD0.12master
-rw-r--r--.travis.yml3
-rw-r--r--CHANGELOG.markdown5
-rw-r--r--log-domain.cabal5
-rw-r--r--src/Numeric/Log.hs52
-rw-r--r--src/Numeric/Log/Signed.hs2
5 files changed, 30 insertions, 37 deletions
diff --git a/.travis.yml b/.travis.yml
index c87b355..140dc9a 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -28,6 +28,9 @@ matrix:
- env: CABALVER=1.24 GHCVER=8.0.2
compiler: ": #GHC 8.0.2"
addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2,hlint], sources: [hvr-ghc]}}
+ - env: CABALVER=2.0 GHCVER=8.2.1
+ compiler: ": #GHC 8.2.1"
+ addons: {apt: {packages: [cabal-install-2.0,ghc-8.2.1,hlint], sources: [hvr-ghc]}}
- env: CABALVER=1.24 GHCVER=head
compiler: ": #GHC head"
addons: {apt: {packages: [cabal-install-1.24,ghc-head,hlint], sources: [hvr-ghc]}}
diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
index e33ce0c..61c35eb 100644
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,3 +1,8 @@
+0.12
+----
+* Drop `safecopy` support
+* Removed some unused constraints.
+
0.11.2
------
* Support `doctest-0.12`
diff --git a/log-domain.cabal b/log-domain.cabal
index d9ef8dd..16ebd4e 100644
--- a/log-domain.cabal
+++ b/log-domain.cabal
@@ -1,6 +1,6 @@
name: log-domain
category: Numeric
-version: 0.11.2
+version: 0.12
license: BSD3
cabal-version: >= 1.8
license-file: LICENSE
@@ -59,7 +59,6 @@ library
hashable >= 1.2.5 && < 1.3,
semigroupoids >= 4 && < 6,
semigroups >= 0.8.4 && < 1,
- safecopy >= 0.8.1 && < 0.10,
vector >= 0.9 && < 0.13
exposed-modules:
@@ -85,7 +84,7 @@ test-suite doctests
else
build-depends:
base,
- doctest >= 0.11.1 && < 0.13,
+ doctest >= 0.11.1 && < 0.14,
generic-deriving,
log-domain,
semigroups >= 0.9,
diff --git a/src/Numeric/Log.hs b/src/Numeric/Log.hs
index 8b42e86..66548b9 100644
--- a/src/Numeric/Log.hs
+++ b/src/Numeric/Log.hs
@@ -41,10 +41,8 @@ import Data.Hashable
import Data.Hashable.Lifted
import Data.Int
import Data.List as List hiding (sum)
-#if __GLASGOW_HASKELL__ < 710
-import Data.Monoid
-#endif
-import Data.SafeCopy
+import Data.List.NonEmpty (NonEmpty(..))
+import Data.Semigroup
import Data.Semigroup.Foldable
import Data.Semigroup.Traversable
import Data.Serialize as Serialize
@@ -68,24 +66,6 @@ import Text.Show as T
-- | @Log@-domain @Float@ and @Double@ values.
newtype Log a = Exp { ln :: a } deriving (Eq,Ord,Data,Typeable,Generic)
---deriveSafeCopy 1 'base ''Log
-
-instance SafeCopy a => SafeCopy (Log a) where
- putCopy (Exp arg_afqB)
- = contain
- (do { safePut_a_afqC <- getSafePut;
- safePut_a_afqC arg_afqB;
- return () })
- getCopy
- = contain
- (label
- "Numeric.Log.Log:"
- (do { safeGet_a_afqD <- getSafeGet;
- ((return Exp) <*> safeGet_a_afqD) }))
- version = 1
- kind = base
- errorTypeName _ = "Numeric.Log.Log"
-
instance (Floating a, Show a) => Show (Log a) where
showsPrec d (Exp a) = T.showsPrec d (exp a)
@@ -345,7 +325,7 @@ instance (Precise a, RealFloat a) => Num (Log a) where
fromInteger = Exp . log . fromInteger
{-# INLINE fromInteger #-}
-instance (Precise a, RealFloat a, Eq a) => Fractional (Log a) where
+instance (Precise a, RealFloat a) => Fractional (Log a) where
-- n/0 == infinity is handled seamlessly for us, as is 0/0 and infinity/infinity NaNs, and 0/infinity == 0.
Exp a / Exp b = Exp (a-b)
{-# INLINE (/) #-}
@@ -370,7 +350,7 @@ newtype instance U.Vector (Log a) = V_Log (U.Vector a)
instance (RealFloat a, Unbox a) => Unbox (Log a)
-instance (RealFloat a, Unbox a) => M.MVector U.MVector (Log a) where
+instance Unbox a => M.MVector U.MVector (Log a) where
{-# INLINE basicLength #-}
{-# INLINE basicUnsafeSlice #-}
{-# INLINE basicOverlaps #-}
@@ -421,20 +401,26 @@ instance (Precise a, RealFloat a, Ord a) => Real (Log a) where
data Acc1 a = Acc1 {-# UNPACK #-} !Int64 !a
-instance (Precise a, RealFloat a) => Monoid (Log a) where
- mempty = Exp negInf
- {-# INLINE mempty #-}
- mappend = (+)
- {-# INLINE mappend #-}
- mconcat [] = 0
- mconcat (Exp z:zs) = Exp $ case List.foldl' step1 (Acc1 0 z) zs of
+instance (Precise a, RealFloat a) => Semigroup (Log a) where
+ (<>) = (+)
+ {-# INLINE (<>) #-}
+ sconcat (Exp z :| zs) = Exp $ case List.foldl' step1 (Acc1 0 z) zs of
Acc1 nm1 a
| isInfinite a -> a
| otherwise -> a + log1p (List.foldl' (step2 a) 0 zs + fromIntegral nm1)
where
step1 (Acc1 n y) (Exp x) = Acc1 (n + 1) (max x y)
step2 a r (Exp x) = r + expm1 (x - a)
- {-# INLINE mconcat #-}
+ {-# INLINE sconcat #-}
+
+instance (Precise a, RealFloat a) => Monoid (Log a) where
+ mempty = Exp negInf
+ {-# INLINE mempty #-}
+#if !(MIN_VERSION_base(4,11,0))
+ mappend = (<>)
+#endif
+ mconcat [] = 0
+ mconcat (x:xs) = sconcat (x :| xs)
logMap :: Floating a => (a -> a) -> Log a -> Log a
logMap f = Exp . log . f . exp . ln
@@ -460,7 +446,7 @@ data Acc a = Acc {-# UNPACK #-} !Int64 !a | None
-- True
--
-- /NB:/ This does require two passes over the data.
-sum :: (RealFloat a, Ord a, Precise a, Foldable f) => f (Log a) -> Log a
+sum :: (RealFloat a, Precise a, Foldable f) => f (Log a) -> Log a
sum xs = Exp $ case Foldable.foldl' step1 None xs of
None -> negInf
Acc nm1 a
diff --git a/src/Numeric/Log/Signed.hs b/src/Numeric/Log/Signed.hs
index 02a5dbb..bae7f07 100644
--- a/src/Numeric/Log/Signed.hs
+++ b/src/Numeric/Log/Signed.hs
@@ -80,7 +80,7 @@ instance (Ord a, Fractional a) => Ord (SignedLog a) where
instance (Show a, RealFloat a, Eq a, Fractional a) => Show (SignedLog a) where
showsPrec d (SLExp s a) = (if not s && a /= negInf && not (isNaN a) then T.showChar '-' else id) . T.showsPrec d (exp a)
-instance (Precise a, RealFloat a, Fractional a, Read a) => Read (SignedLog a) where
+instance (Precise a, RealFloat a, Read a) => Read (SignedLog a) where
readPrec = (realToFrac :: a -> SignedLog a) <$> step T.readPrec
nxor :: Bool -> Bool -> Bool