diff --git a/Data/Vector/Multi.hs b/Data/Vector/Multi.hs new file mode 100644 --- /dev/null +++ b/Data/Vector/Multi.hs @@ -0,0 +1,35 @@ +module Data.Vector.Multi (Vector, MVector) where + +import Control.Applicative +import Data.Function (on) +import qualified Data.Vector as V +import qualified Data.Vector.Generic as G +import qualified Data.Vector.Generic.Mutable as MG +import GHC.Exts (Any) +import Unsafe.Coerce + +newtype Vector a = Vector { raw :: V.Vector Any } +newtype MVector s a = MVector { mraw :: V.MVector s Any } + +type instance G.Mutable Vector = MVector + +instance G.Vector Vector (a, b) where + basicUnsafeFreeze = fmap Vector . G.basicUnsafeFreeze . mraw + basicUnsafeThaw = fmap MVector . G.basicUnsafeThaw . raw + basicLength = (`div` 2) . G.basicLength . raw + basicUnsafeSlice m n = Vector . G.basicUnsafeSlice (2*m) (2*n) . raw + basicUnsafeIndexM (Vector xs) k = unsafeCoerce <$> (liftA2 (,) `on` G.basicUnsafeIndexM xs) (2*k) (2*k+1) + basicUnsafeCopy (MVector xs) (Vector ys) = G.basicUnsafeCopy xs ys + +instance MG.MVector MVector (a, b) where + basicLength = (`div` 2) . MG.basicLength . mraw + basicUnsafeSlice m n = MVector . MG.basicUnsafeSlice (2*m) (2*n) . mraw + basicOverlaps = MG.basicOverlaps `on` mraw + basicUnsafeNew = fmap MVector . MG.basicUnsafeNew + basicInitialize = MG.basicInitialize . mraw + basicUnsafeRead xs k = unsafeCoerce <$> (liftA2 (,) `on` MG.basicUnsafeRead xs) (2*k) (2*k+1) + basicUnsafeWrite (MVector xs) k (a, b) = MG.basicUnsafeWrite xs (2*k) (unsafeCoerce a) *> + MG.basicUnsafeWrite xs (2*k+1) (unsafeCoerce b) + basicUnsafeCopy = MG.basicUnsafeCopy `on` mraw + basicUnsafeMove = MG.basicUnsafeMove `on` mraw + basicUnsafeGrow (MVector xs) k = MVector <$> MG.basicUnsafeGrow xs (2*k) diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright M Farkas-Dyck © 2018 + +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 M Farkas-Dyck 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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,1 @@ +# Vector diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/multivector.cabal b/multivector.cabal new file mode 100644 --- /dev/null +++ b/multivector.cabal @@ -0,0 +1,66 @@ +name: multivector +version: 0.1.0.0 +synopsis: Vectors of packed tuples +-- description: +license: BSD3 +license-file: LICENSE +author: M Farkas-Dyck +maintainer: strake888@gmail.com +copyright: 2018 M Farkas-Dyck +category: Data +build-type: Simple +extra-source-files: README.md +cabal-version: >=1.10 + +library + exposed-modules: Data.Vector.Multi + build-depends: base >= 4.7 && < 5 + , vector >=0.12 && <0.13 + default-language: Haskell2010 + default-extensions: UnicodeSyntax + , LambdaCase + , InstanceSigs + , PartialTypeSignatures + , PolyKinds + , ConstraintKinds + , FlexibleContexts + , FlexibleInstances + , MultiParamTypeClasses + , TypeFamilies + , StandaloneDeriving + , DeriveFunctor + , DeriveFoldable + , DeriveTraversable + , OverloadedStrings + ghc-options: -Wall -Wcompat -Wredundant-constraints -Wno-name-shadowing + -Wincomplete-record-updates -Wincomplete-uni-patterns + +test-suite test + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + build-depends: base >=4.11 && <5 + , smallcheck >=1.1 + , tasty >=1.0 + , tasty-smallcheck >=0.8 + , Vector + default-language: Haskell2010 + default-extensions: UnicodeSyntax + , LambdaCase + , InstanceSigs + , PartialTypeSignatures + , PolyKinds + , ConstraintKinds + , FlexibleContexts + , FlexibleInstances + , StandaloneDeriving + , DeriveFunctor + , DeriveFoldable + , DeriveTraversable + , OverloadedStrings + ghc-options: -Wall -Wcompat -Wredundant-constraints -Wno-name-shadowing + -Wincomplete-record-updates -Wincomplete-uni-patterns + +source-repository head + type: git + location: https://github.com/strake/Vector diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,8 @@ +module Main where + +import Test.SmallCheck +import Test.Tasty +import Test.Tasty.SmallCheck + +main :: IO () +main = pure ()