prim-instances (empty) → 0.1.0.0
raw patch · 6 files changed
+309/−0 lines, 6 filesdep +QuickCheckdep +basedep +base-orphanssetup-changed
Dependencies added: QuickCheck, base, base-orphans, prim-instances, primitive, quickcheck-classes, quickcheck-instances, tasty, tasty-quickcheck
Files
- ChangeLog.md +5/−0
- LICENSE +30/−0
- Setup.hs +2/−0
- prim-instances.cabal +38/−0
- src/Data/Primitive/Instances.hs +195/−0
- test/main.hs +39/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for prim-instances++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2018, chessai++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of chessai nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ prim-instances.cabal view
@@ -0,0 +1,38 @@+name: prim-instances+version: 0.1.0.0+synopsis: prim typeclass instances+description: orphan instances for primitive's 'Prim' typeclass.+ Types which abstract over a single primitive type+ have trivially lawful and sometimes useful instances.+homepage: https://github.com/chessai/prim-instances.git+license: BSD3+license-file: LICENSE+author: chessai+maintainer: chessai1996@gmail.com+copyright: 2018 (c) chessai+category: Data+build-type: Simple+extra-source-files: ChangeLog.md+cabal-version: >=1.10++library+ exposed-modules: Data.Primitive.Instances+ build-depends: base >=4.7 && <4.13, primitive >= 0.6.4.0+ hs-source-dirs: src+ default-language: Haskell2010++test-suite test+ default-language: Haskell2010+ hs-source-dirs: test+ main-is: main.hs+ type: exitcode-stdio-1.0+ build-depends:+ base >= 4.7 && < 4.12+ , QuickCheck+ , base-orphans+ , quickcheck-classes >= 0.4.11.1+ , quickcheck-instances+ , primitive >= 0.6.4.0 + , prim-instances + , tasty+ , tasty-quickcheck
+ src/Data/Primitive/Instances.hs view
@@ -0,0 +1,195 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE InstanceSigs #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+#if __GLASGOW_HASKELL__ >= 800+{-# LANGUAGE TypeInType #-}+#endif+{-# LANGUAGE UnboxedTuples #-}++{-# OPTIONS_GHC+ -Weverything+ -fno-warn-unsafe+ -fno-warn-orphans+ -fno-warn-name-shadowing+ -fno-warn-missing-import-lists+ -fno-warn-implicit-prelude+ -O2+#-}++-- | Orphan instances for the 'Prim' typeclass.+module Data.Primitive.Instances () where++import Data.Complex (Complex(..))+import Data.Functor.Const (Const(..))+#if MIN_VERSION_base(4,8,0)+import Data.Functor.Identity (Identity(..))+#endif+import qualified Data.Monoid as Monoid+import qualified Data.Semigroup as Semigroup+import Data.Ord (Down(..))+--import Data.Primitive.ByteArray+import Data.Primitive.Types (Prim(..), defaultSetOffAddr#, defaultSetByteArray#)+import GHC.Real (Ratio(..))+import Data.Word (Word64)+import GHC.Fingerprint (Fingerprint(..))+import GHC.Exts (State#, Int#, Addr#, MutableByteArray#, (+#), (*#))++instance Prim a => Prim (Complex a) where+ sizeOf# _ = 2# *# sizeOf# (undefined :: a)+ alignment# _ = alignment# (undefined :: a)+ indexByteArray# arr# i# =+ let x,y :: a+ x = indexByteArray# arr# (2# *# i#)+ y = indexByteArray# arr# (2# *# i# +# 1#) + in x :+ y+ readByteArray# :: forall s a. (Prim a) => MutableByteArray# s -> Int# -> State# s -> (# State# s, Complex a #)+ readByteArray# arr# i# =+ \s0 -> case readByteArray# arr# (2# *# i#) s0 of+ (# s1#, x #) -> case readByteArray# arr# (2# *# i# +# 1#) s1# of+ (# s2#, y #) -> (# s2#, x :+ y #)+ writeByteArray# :: forall s a. (Prim a) => MutableByteArray# s -> Int# -> Complex a -> State# s -> State# s+ writeByteArray# arr# i# (a :+ b) =+ \s0 -> case writeByteArray# arr# (2# *# i#) a s0 of+ s1 -> case writeByteArray# arr# (2# *# i# +# 1#) b s1 of+ s2 -> s2+ setByteArray# = defaultSetByteArray#+ indexOffAddr# :: Addr# -> Int# -> Complex a+ indexOffAddr# addr# i# =+ let x,y :: a+ x = indexOffAddr# addr# (2# *# i#)+ y = indexOffAddr# addr# (2# *# i# +# 1#)+ in x :+ y+ readOffAddr# :: forall s a. (Prim a) => Addr# -> Int# -> State# s -> (# State# s, Complex a #)+ readOffAddr# addr# i# =+ \s0 -> case readOffAddr# addr# (2# *# i#) s0 of+ (# s1, x #) -> case readOffAddr# addr# (2# *# i# +# 1#) s1 of+ (# s2, y #) -> (# s2, x :+ y #)+ writeOffAddr# :: forall s a. (Prim a) => Addr# -> Int# -> Complex a -> State# s -> State# s+ writeOffAddr# addr# i# (a :+ b) =+ \s0 -> case writeOffAddr# addr# (2# *# i#) a s0 of+ s1 -> case writeOffAddr# addr# (2# *# i# +# 1#) b s1 of+ s2 -> s2+ setOffAddr# = defaultSetOffAddr#+ {-# INLINE sizeOf# #-}+ {-# INLINE alignment# #-}+ {-# INLINE indexByteArray# #-}+ {-# INLINE readByteArray# #-}+ {-# INLINE writeByteArray# #-}+ {-# INLINE setByteArray# #-}+ {-# INLINE indexOffAddr# #-}+ {-# INLINE readOffAddr# #-}+ {-# INLINE writeOffAddr# #-}+ {-# INLINE setOffAddr# #-}++instance (Integral a, Prim a) => Prim (Ratio a) where+ sizeOf# _ = 2# *# sizeOf# (undefined :: a) + alignment# _ = alignment# (undefined :: a) + indexByteArray# arr# i# =+ let x,y :: a+ x = indexByteArray# arr# (2# *# i#)+ y = indexByteArray# arr# (2# *# i# +# 1#) + in x :% y+ readByteArray# :: forall s a. (Prim a) => MutableByteArray# s -> Int# -> State# s -> (# State# s, Ratio a #)+ readByteArray# arr# i# =+ \s0 -> case readByteArray# arr# (2# *# i#) s0 of+ (# s1#, x #) -> case readByteArray# arr# (2# *# i# +# 1#) s1# of+ (# s2#, y #) -> (# s2#, x :% y #)+ writeByteArray# :: forall s a. (Prim a) => MutableByteArray# s -> Int# -> Ratio a -> State# s -> State# s+ writeByteArray# arr# i# (a :% b) =+ \s0 -> case writeByteArray# arr# (2# *# i#) a s0 of+ s1 -> case writeByteArray# arr# (2# *# i# +# 1#) b s1 of+ s2 -> s2+ setByteArray# = defaultSetByteArray#+ indexOffAddr# :: Addr# -> Int# -> Ratio a+ indexOffAddr# addr# i# =+ let x,y :: a+ x = indexOffAddr# addr# (2# *# i#)+ y = indexOffAddr# addr# (2# *# i# +# 1#)+ in x :% y+ readOffAddr# :: forall s a. (Prim a) => Addr# -> Int# -> State# s -> (# State# s, Ratio a #)+ readOffAddr# addr# i# =+ \s0 -> case readOffAddr# addr# (2# *# i#) s0 of+ (# s1, x #) -> case readOffAddr# addr# (2# *# i# +# 1#) s1 of+ (# s2, y #) -> (# s2, x :% y #)+ writeOffAddr# :: forall s a. (Prim a) => Addr# -> Int# -> Ratio a -> State# s -> State# s+ writeOffAddr# addr# i# (a :% b) =+ \s0 -> case writeOffAddr# addr# (2# *# i#) a s0 of+ s1 -> case writeOffAddr# addr# (2# *# i# +# 1#) b s1 of+ s2 -> s2+ setOffAddr# = defaultSetOffAddr#+ {-# INLINE sizeOf# #-}+ {-# INLINE alignment# #-}+ {-# INLINE indexByteArray# #-}+ {-# INLINE readByteArray# #-}+ {-# INLINE writeByteArray# #-}+ {-# INLINE setByteArray# #-}+ {-# INLINE indexOffAddr# #-}+ {-# INLINE readOffAddr# #-}+ {-# INLINE writeOffAddr# #-}+ {-# INLINE setOffAddr# #-}++instance Prim Fingerprint where + sizeOf# _ = 2# *# sizeOf# (undefined :: Word64)+ alignment# _ = alignment# (undefined :: Word64)+ indexByteArray# arr# i# =+ let x,y :: Word64+ x = indexByteArray# arr# (2# *# i#)+ y = indexByteArray# arr# (2# *# i# +# 1#) + in Fingerprint x y+ readByteArray# :: forall s. MutableByteArray# s -> Int# -> State# s -> (# State# s, Fingerprint #)+ readByteArray# arr# i# =+ \s0 -> case readByteArray# arr# (2# *# i#) s0 of+ (# s1#, x #) -> case readByteArray# arr# (2# *# i# +# 1#) s1# of+ (# s2#, y #) -> (# s2#, Fingerprint x y #)+ writeByteArray# :: forall s. MutableByteArray# s -> Int# -> Fingerprint -> State# s -> State# s+ writeByteArray# arr# i# (Fingerprint a b) =+ \s0 -> case writeByteArray# arr# (2# *# i#) a s0 of+ s1 -> case writeByteArray# arr# (2# *# i# +# 1#) b s1 of+ s2 -> s2+ setByteArray# = defaultSetByteArray#+ indexOffAddr# :: Addr# -> Int# -> Fingerprint+ indexOffAddr# addr# i# =+ let x,y :: Word64+ x = indexOffAddr# addr# (2# *# i#)+ y = indexOffAddr# addr# (2# *# i# +# 1#)+ in Fingerprint x y+ readOffAddr# :: forall s. Addr# -> Int# -> State# s -> (# State# s, Fingerprint #)+ readOffAddr# addr# i# =+ \s0 -> case readOffAddr# addr# (2# *# i#) s0 of+ (# s1, x #) -> case readOffAddr# addr# (2# *# i# +# 1#) s1 of+ (# s2, y #) -> (# s2, Fingerprint x y #)+ writeOffAddr# :: forall s. Addr# -> Int# -> Fingerprint -> State# s -> State# s+ writeOffAddr# addr# i# (Fingerprint a b) =+ \s0 -> case writeOffAddr# addr# (2# *# i#) a s0 of+ s1 -> case writeOffAddr# addr# (2# *# i# +# 1#) b s1 of+ s2 -> s2+ setOffAddr# = defaultSetOffAddr#+ {-# INLINE sizeOf# #-}+ {-# INLINE alignment# #-}+ {-# INLINE indexByteArray# #-}+ {-# INLINE readByteArray# #-}+ {-# INLINE writeByteArray# #-}+ {-# INLINE setByteArray# #-}+ {-# INLINE indexOffAddr# #-}+ {-# INLINE readOffAddr# #-}+ {-# INLINE writeOffAddr# #-}+ {-# INLINE setOffAddr# #-}++deriving instance Prim a => Prim (Down a)+#if MIN_VERSION_base(4,8,0)+deriving instance Prim a => Prim (Identity a)+deriving instance Prim a => Prim (Monoid.Dual a)+deriving instance Prim a => Prim (Monoid.Sum a)+deriving instance Prim a => Prim (Monoid.Product a)+#endif+#if MIN_VERSION_base(4,9,0)+deriving instance Prim a => Prim (Semigroup.First a)+deriving instance Prim a => Prim (Semigroup.Last a)+deriving instance Prim a => Prim (Semigroup.Min a)+deriving instance Prim a => Prim (Semigroup.Max a)+#endif+deriving instance Prim a => Prim (Const a b)
+ test/main.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE DeriveFunctor #-}++import Data.Complex+import Data.Proxy (Proxy(..))+import Data.Ratio (Ratio(..))+import Data.Word (Word64)+import GHC.Fingerprint (Fingerprint)+import Test.QuickCheck hiding (Fixed)+import Test.QuickCheck.Gen (suchThat)+import Test.QuickCheck.Instances ()+import Test.Tasty (defaultMain, testGroup, TestTree)+import Data.Primitive.Instances+import Data.Primitive.Types (Prim(..))+import qualified GHC.Num as Num+import qualified Test.QuickCheck.Classes as QCC++type Laws = QCC.Laws++main :: IO ()+main = QCC.lawsCheckMany namedTests+ where+ namedTests :: [(String, [Laws])]+ namedTests =+ [ ("Complex Double", myLaws pComplex)+ , ("Ratio Int", myLaws pRatio)+ , ("Fingerprint", myLaws pRatio)+ ]+ myLaws :: (Arbitrary a, Show a, Eq a, Prim a) => Proxy a -> [Laws]+ myLaws p = [QCC.primLaws p]++p :: forall a. Proxy a; p = Proxy++pComplex = p @(Complex Double)+pRatio = p @(Ratio Int)+pFingerprint = p @Fingerprint