packages feed

wordn (empty) → 0.1.0.0

raw patch · 12 files changed

+537/−0 lines, 12 filesdep +HUnitdep +OddWorddep +QuickChecksetup-changed

Dependencies added: HUnit, OddWord, QuickCheck, base, deepseq, gauge, ghc-prim, primitive, quickcheck-classes, tasty, tasty-hunit, tasty-quickcheck, weigh, wordn

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for wordn++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2020 Zachary Churchill++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/Main.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE+    BangPatterns+  , GADTs+  , DeriveGeneric+  , StandaloneDeriving+  , MagicHash+  , DataKinds+  , GeneralizedNewtypeDeriving+  , TypeApplications+  , ScopedTypeVariables+#-}++{-# OPTIONS_GHC+    -fno-warn-orphans+#-}++import Gauge.Main (defaultMain, bench, nf)++import Data.Word+import Control.DeepSeq+import Unsafe.Coerce+import Control.Exception+import qualified WordN.Word8 as Word8+import qualified Weigh+import qualified Data.Word.Odd as Odd++deriving instance NFData (Word8.WordN n)++type OddWord8 = Odd.OddWord Word8 (Odd.Lit 8)++instance NFData a => NFData (Odd.OddWord a n) where+  rnf x = rnf $ (unsafeCoerce x :: a)++main :: IO ()+main = do+  defaultMain+    [+    ]+  putStr "Memory usage :"+  Weigh.mainWith $ do+    Weigh.action "Word8" w8+    Weigh.action "WordN 8" wn8+    Weigh.action "OddWord 8 Word8" oddword8++{-# NOINLINE w8 #-}+w8 :: IO Word8+w8 = evaluate maxBound++{-# NOINLINE wn8 #-}+wn8 :: IO (Word8.WordN 8)+wn8 = evaluate maxBound++{-# NOINLINE oddword8 #-}+oddword8 :: IO OddWord8+oddword8 = evaluate maxBound
+ src-wordn-indef/WordN.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE+    MagicHash+  , TypeOperators+  , DataKinds+  , KindSignatures+  , TypeFamilies+  , StandaloneDeriving+  , GeneralizedNewtypeDeriving+  , TypeApplications+  , ScopedTypeVariables+#-}++module WordN +  ( WordN(..)+  , NoMask(..)+  , maskWordN+  , wordNMask+  , preserveBits+  , preserveBitsR+  ) where++import Data.Bits+import GHC.TypeNats+import GHC.Types+import GHC.Enum+import GHC.Prim+import GHC.Real+import qualified WordSize++data Proxy (n :: Nat) = Proxy++newtype WordN (n :: Nat) = WordN { getWord :: WordSize.T }++instance (KnownNat n, n <= WordSize.MaxBits) => Num (WordN n) where+  (WordN l) + (WordN r) = maskWordN $ (l + r)+  (WordN l) * (WordN r) = maskWordN $ (l * r)+  (WordN l) - (WordN r) = maskWordN $ (l - r)+  negate (WordN x)   = maskWordN $ negate x+  abs w = w+  signum (WordN x) +    | x == 0 = 0+    | otherwise = 1+  fromInteger i = maskWordN $ fromInteger i ++instance (n <= WordSize.MaxBits) => Show (WordN n) where+  show (WordN w) = show w++deriving instance (n <= WordSize.MaxBits) => Eq (WordN n)+deriving instance (n <= WordSize.MaxBits) => Ord (WordN n)+deriving instance (KnownNat n, n <= WordSize.MaxBits) => Real (WordN n)++deriving instance (KnownNat n, n <= WordSize.MaxBits) => Integral (WordN n)++instance (KnownNat n, n <= WordSize.MaxBits) => Enum (WordN n) where+  succ x+    | x /= maxBound = x + 1+    | otherwise     = succError "WordN"++  pred x+    | x /= minBound = x - 1+    | otherwise     = predError "WordN"++  toEnum i@(I# i#)+    | i >= 0    = WordN $ WordSize.liftWord (int2Word# i#)+    | otherwise = toEnumError "WordN" i (minBound::WordN n, maxBound::WordN n)++  fromEnum x@(WordN x')+    | x <= fromIntegral (maxBound :: Int) = I# (word2Int# (WordSize.unliftWord x'))+    | otherwise = fromEnumError "WordN" x++  enumFrom       = integralEnumFrom+  enumFromThen   = integralEnumFromThen+  enumFromTo     = integralEnumFromTo+  enumFromThenTo = integralEnumFromThenTo++instance forall n. (KnownNat n, n <= WordSize.MaxBits) => Bounded (WordN n) where+  minBound = 0+  maxBound = wordNMask++instance (KnownNat n, n <= WordSize.MaxBits) => Bits (WordN n) where+    (WordN l) .&. (WordN r) = WordN $ l .&. r+    (WordN l) .|. (WordN r) = WordN $ l .|. r+    xor (WordN l) (WordN r) = WordN $ xor l r+    complement x = x `xor` wordNMask+    bit n | n < (fromIntegral $ natVal (Proxy :: Proxy n))+          = WordN $ bit n+          | otherwise = WordN 0+    setBit (WordN x) n | n < (fromIntegral $ natVal (Proxy :: Proxy n))+                    = WordN $ setBit x n+                    | otherwise = WordN x+    clearBit (WordN x) n = WordN $ clearBit x n+    complementBit (WordN x) n | n < (fromIntegral $ natVal (Proxy :: Proxy n))+                           = WordN $ complementBit x n+                           | otherwise = WordN x+    testBit (WordN x) n = testBit x n+    bitSize _ = fromIntegral $ natVal (Proxy :: Proxy n)+    bitSizeMaybe _ = Just $ fromIntegral $ natVal (Proxy :: Proxy n)+    isSigned _ = False +    shiftL (WordN x) n = maskWordN $ shiftL x n+    shiftR (WordN x) n = WordN $ shiftR x n+    rotateL (WordN x) n = WordN $+        (shiftL x n' .&. getWord (wordNMask :: WordN n)) .|. shiftR x (w-n')+        where n' = n `mod` w+              w = fromIntegral $ natVal (Proxy :: Proxy n)+    rotateR (WordN x) n = WordN $+        shiftR x n' .|. (shiftL x (w-n') .&. getWord (wordNMask :: WordN n))+        where n' = n `mod` w+              w  = fromIntegral $ natVal (Proxy :: Proxy n)+    popCount (WordN x) = popCount x++instance (KnownNat n, n <= WordSize.MaxBits) => FiniteBits (WordN n) where+    finiteBitSize _ = fromIntegral $ natVal (Proxy :: Proxy n) +    countLeadingZeros (WordN x) =+        subWordClz (fromIntegral $ natVal (Proxy :: Proxy n)) x+    countTrailingZeros (WordN x) =+        subWordCtz (fromIntegral $ natVal (Proxy :: Proxy n)) x++--------------------------------------------------------------------------++newtype NoMask (n :: Nat) = NoMask { noMask :: WordSize.T }++instance forall n. (KnownNat n , n <= WordSize.MaxBits) => Show (NoMask n) where+  show (NoMask w) = show $ (maskWordN w :: WordN n)++deriving instance (n <= WordSize.MaxBits) => Eq (NoMask n)+deriving instance (n <= WordSize.MaxBits) => Ord (NoMask n)++instance forall n. (KnownNat n, n <= WordSize.MaxBits) => Bounded (NoMask n) where+  minBound = NoMask 0+  maxBound = NoMask $ getWord (wordNMask :: WordN n)++{-# INLINE wordNMask #-}+-- | An (WordN n) with all the bits set, used for masking.+wordNMask :: forall n. (KnownNat n) => WordN n+wordNMask = WordN . (flip (-) 1) . bit $ fromIntegral bits+  where +  bits = natVal (Proxy :: Proxy n)++{-# INLINE maskWordN #-}+-- | Smart constructor for WrapWords which masks off the unused upper bits.+maskWordN :: forall n. (KnownNat n) => WordSize.T -> WordN n+maskWordN w = WordN $ w .&. getWord (wordNMask :: WordN n)++{-# INLINE preserveBits #-}+preserveBits :: forall n. KnownNat n => (WordSize.T -> WordSize.T) -> NoMask n -> NoMask n+preserveBits f w = preserveBitsR (\_ w2 -> f w2) (NoMask 0) w++{-# INLINE preserveBitsR #-}+preserveBitsR :: forall n. KnownNat n => (WordSize.T -> WordSize.T -> WordSize.T) -> NoMask n -> NoMask n -> NoMask n+preserveBitsR f (NoMask w1) (NoMask w2) = +  let w1' = getWord (maskWordN w1 :: WordN n)+      w2' = getWord (maskWordN w2 :: WordN n)+      mask = getWord (wordNMask :: WordN n)+      upper = w2 .&. complement mask+   in NoMask $ (f w1' w2') .|. upper++-- | Count the leading zeros on a @w@-bit wide word.+subWordClz :: Int -> WordSize.T -> Int+subWordClz w x = countLeadingZeros x + w - finiteBitSize x++-- | Count the trailing zeros on a @w@-bit wide word.+subWordCtz :: Int -> WordSize.T -> Int+subWordCtz w x = min (countTrailingZeros x) w+
+ src-wordn-indef/WordSize.hsig view
@@ -0,0 +1,41 @@+{-# language DataKinds #-}+{-# language KindSignatures #-}+{-# language MagicHash #-}+{-# language UnboxedTuples #-}+{-# language StandaloneKindSignatures #-}++signature WordSize +  ( T+  , T#+  , R+  , MaxBits+  , liftWord+  , unliftWord+  ) where++import Prelude (Num,Integral,Real,Bounded,Enum,Eq,Ord,Show)+import Data.Bits (Bits,FiniteBits)++import GHC.Exts (TYPE,RuntimeRep,Word#)+import GHC.TypeLits++instance Num T+instance Integral T+instance Real T+instance Bounded T+instance Enum T+instance Eq T+instance Ord T+instance Show T+instance Bits T+instance FiniteBits T++data T+data R :: RuntimeRep+data T# :: TYPE R+data MaxBits :: Nat++liftWord :: Word# -> T+unliftWord :: T -> Word#++
+ src/Impl/Word16.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE+    MagicHash+  , DataKinds+#-}++module Impl.Word16 where++import Data.Word+import GHC.Exts+import GHC.Word++type T = Word16+type R = 'Word16Rep+type T# = Word16#+type MaxBits = 16++{-# INLINE liftWord #-}+liftWord :: Word# -> Word16+liftWord = W16#++{-# INLINE unliftWord #-}+unliftWord :: Word16 -> Word#+unliftWord (W16# w) = w
+ src/Impl/Word32.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE+    MagicHash+  , DataKinds+#-}++module Impl.Word32 where++import Data.Word+import GHC.Exts+import GHC.Word++type T = Word32+type R = 'Word32Rep+type T# = Word32#+type MaxBits = 32++{-# INLINE liftWord #-}+liftWord :: Word# -> Word32+liftWord = W32#++{-# INLINE unliftWord #-}+unliftWord :: Word32 -> Word#+unliftWord (W32# w) = w
+ src/Impl/Word64.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE+    MagicHash+  , DataKinds+#-}++module Impl.Word64 where++import Data.Word+import GHC.Exts+import GHC.Word++type T = Word64+type R = 'Word64Rep+type T# = Word64#+type MaxBits = 64++{-# INLINE liftWord #-}+liftWord :: Word# -> Word64+liftWord = W64#++{-# INLINE unliftWord #-}+unliftWord :: Word64 -> Word#+unliftWord (W64# w) = w
+ src/Impl/Word8.hs view
@@ -0,0 +1,23 @@+{-# LANGUAGE+    MagicHash+  , DataKinds+#-}++module Impl.Word8 where++import Data.Word+import GHC.Exts+import GHC.Word++type T = Word8+type R = 'Word8Rep+type T# = Word8#+type MaxBits = 8++{-# INLINE liftWord #-}+liftWord :: Word# -> Word8+liftWord = W8#++{-# INLINE unliftWord #-}+unliftWord :: Word8 -> Word#+unliftWord (W8# w) = w
+ test/Main.hs view
@@ -0,0 +1,51 @@+{-# LANGUAGE +    MagicHash +  , TemplateHaskell+  , TypeApplications+  , DataKinds+#-}++{-# OPTIONS_GHC+    -fno-warn-orphans+#-}++module Main where++import Test.Tasty+-- import Test.Tasty.HUnit+import Test.Tasty.QuickCheck+import Test.QuickCheck.Classes+import Data.Proxy+import GHC.TypeLits+import qualified WordN.Word8 as Word8++instance KnownNat n => Arbitrary (Word8.WordN n) where+  arbitrary = Word8.maskWordN <$> arbitrary++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Tests" [unitTests, typeclassLaws]++unitTests :: TestTree+unitTests = testGroup "Unit tests"+  [+  ]++typeclassLaws :: TestTree+typeclassLaws = testGroup "Typeclass Laws"+  [ testLaws $ numLaws         (Proxy @(Word8.WordN 8))+  , testLaws $ eqLaws          (Proxy @(Word8.WordN 8))+  , testLaws $ bitsLaws        (Proxy @(Word8.WordN 8))+  , testLaws $ bitsLaws        (Proxy @(Word8.WordN 8))+  , testLaws $ integralLaws    (Proxy @(Word8.WordN 8))+  , testLaws $ ordLaws         (Proxy @(Word8.WordN 8))+  , testLaws $ boundedEnumLaws (Proxy @(Word8.WordN 8))+  ]++unwrap :: Either a b -> b+unwrap = either (error "unwrap") id++testLaws :: Laws -> TestTree+testLaws (Laws tc lp) = testProperties tc lp
+ wordn.cabal view
@@ -0,0 +1,107 @@+cabal-version: 2.0+-- Initial package description 'wordn.cabal' generated by 'cabal init'.+-- For further documentation, see http://haskell.org/cabal/users-guide/++name: wordn+version: 0.1.0.0+synopsis: arbitrary bit size Words+description: Monomorphized arbitrary bitsize words using backpack. Aims to allocate as little as possible, without exporting a monomoprhised type for every possible @Word@ size+bug-reports: https://github.com/goolord/wordn/issues+license: MIT+license-file: LICENSE+author: Zachary Churchill+maintainer: zacharyachurchill@gmail.com+-- copyright:+category: Data+build-type: Simple+extra-source-files: CHANGELOG.md++library+  build-depends: +      base >=4.12.0.0 && <5.2+    , wordn-indef+    , wordn-impl+    , ghc-prim >= 0.5.3 && < 0.7++  reexported-modules:+      WordN.Word8+    , WordN.Word16+    , WordN.Word32+    , WordN.Word64+  default-language: Haskell2010+  ghc-options: -Wall -O2+  mixins:+      wordn-indef (WordN as WordN.Word8)+        requires (WordSize as Impl.Word8)+    , wordn-indef (WordN as WordN.Word16)+        requires (WordSize as Impl.Word16)+    , wordn-indef (WordN as WordN.Word32)+        requires (WordSize as Impl.Word32)+    , wordn-indef (WordN as WordN.Word64)+        requires (WordSize as Impl.Word64)++library wordn-indef+  exposed-modules: +      WordN+  build-depends:+      base+    , ghc-prim+  hs-source-dirs: src-wordn-indef+  default-language: Haskell2010+  ghc-options: -Wall -O2+  signatures: WordSize++library wordn-impl+  build-depends: +      base+    , ghc-prim+  exposed-modules:+      Impl.Word8+    , Impl.Word16+    , Impl.Word32+    , Impl.Word64+  hs-source-dirs: src+  default-language: Haskell2010+  ghc-options: -Wall -O2++benchmark bench+  type: exitcode-stdio-1.0+  build-depends:+      base+    , gauge+    , weigh == 0.0.16+    , wordn+    , deepseq+    , OddWord+  ghc-options: -Wall -O0+  default-language: Haskell2010+  hs-source-dirs: bench+  main-is: Main.hs++test-suite test+  type:+    exitcode-stdio-1.0+  hs-source-dirs:+    test+  main-is:+    Main.hs+  build-depends:+      HUnit+    , tasty+    , base+    , tasty-hunit+    , tasty-quickcheck+    , QuickCheck+    , quickcheck-classes+    , primitive+    , wordn+  ghc-options:+    -Wall+    -O2+  default-language:+    Haskell2010++source-repository head+    type:     git+    location: https://github.com/goolord/wordn.git+