vector-th-unbox-0.2.2/0000755000000000000000000000000007346545000012750 5ustar0000000000000000vector-th-unbox-0.2.2/CHANGELOG.md0000644000000000000000000000027707346545000014567 0ustar0000000000000000## 0.2.2 * Fixed the build failure on GHC 9.2 * Dropped the support for GHC older than 8.0 ## 0.2.1.9 * Fixed the build failure on GHC 7.10.3 (and older) ## 0.2.1.8 * Supported GHC 9.0.1vector-th-unbox-0.2.2/Data/Vector/Unboxed/0000755000000000000000000000000007346545000016467 5ustar0000000000000000vector-th-unbox-0.2.2/Data/Vector/Unboxed/Deriving.hs0000644000000000000000000001634007346545000020576 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskellQuotes #-} {-# LANGUAGE Trustworthy #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE ViewPatterns #-} {-# OPTIONS -Wall #-} {-| Module: Data.Vector.Unboxed.Deriving Copyright: © 2012−2015 Liyang HU License: BSD3 Maintainer: vector-th-unbox@liyang.hu Stability: experimental Portability: non-portable -} module Data.Vector.Unboxed.Deriving ( -- $usage derivingUnbox ) where import Control.Arrow import Control.Monad import Data.Char (isAlphaNum) import qualified Data.Vector.Generic as G import qualified Data.Vector.Generic.Mutable as M import Data.Vector.Unboxed.Base (MVector (..), Vector (..), Unbox) import Language.Haskell.TH -- Create a @Pat@ bound to the given name and an @Exp@ for said binding. newPatExp :: String -> Q (Pat, Exp) newPatExp = fmap (VarP &&& VarE) . newName data Common = Common { mvName, vName :: Name , i, n, mv, mv', v :: (Pat, Exp) } common :: String -> Q Common common name = do -- A bit looser than “Haskell 2010: §2.4 Identifiers and Operators”… let valid c = c == '_' || c == '\'' || c == '#' || isAlphaNum c unless (all valid name) $ do fail (show name ++ " is not a valid constructor suffix!") let mvName = mkName ("MV_" ++ name) let vName = mkName ("V_" ++ name) i <- newPatExp "idx" n <- newPatExp "len" mv <- first (conPCompat mvName . (:[])) <$> newPatExp "mvec" mv' <- first (conPCompat mvName . (:[])) <$> newPatExp "mvec'" v <- first (conPCompat vName . (:[])) <$> newPatExp "vec" return Common {..} where conPCompat n pats = ConP n #if MIN_VERSION_template_haskell(2,18,0) [] #endif pats liftE :: Exp -> Exp -> Exp liftE e = InfixE (Just e) (VarE 'liftM) . Just -- Create a wrapper for the given function with the same 'nameBase', given -- a list of argument bindings and expressions in terms of said bindings. -- A final coercion (@Exp → Exp@) is applied to the body of the function. -- Complimentary @INLINE@ pragma included. wrap :: Name -> [(Pat, Exp)] -> (Exp -> Exp) -> [Dec] wrap name (unzip -> (pats, exps)) coerce = [inline, method] where inline = PragmaD (InlineP name Inline FunLike AllPhases) body = coerce $ foldl AppE (VarE name) exps method = FunD name [Clause pats (NormalB body) []] {-| Let's consider a more complex example: suppose we want an @Unbox@ instance for @Maybe a@. We could encode this using the pair @(Bool, a)@, with the boolean indicating whether we have @Nothing@ or @Just@ something. This encoding requires a dummy value in the @Nothing@ case, necessitating an additional constraint. Thus: >derivingUnbox "Maybe" > [t| ∀ a. (Default a, Unbox a) ⇒ Maybe a → (Bool, a) |] > [| maybe (False, def) (\ x → (True, x)) |] > [| \ (b, x) → if b then Just x else Nothing |] -} derivingUnbox :: String -- ^ Unique constructor suffix for the MVector and Vector data families -> TypeQ -- ^ Quotation of the form @[t| /ctxt/ ⇒ src → rep |]@ -> ExpQ -- ^ Quotation of an expression of type @src → rep@ -> ExpQ -- ^ Quotation of an expression of type @rep → src@ -> DecsQ -- ^ Declarations to be spliced for the derived Unbox instance derivingUnbox name argsQ toRepQ fromRepQ = do Common {..} <- common name toRep <- toRepQ fromRep <- fromRepQ a <- second (AppE toRep) <$> newPatExp "val" args <- argsQ (cxts, typ, rep) <- case args of ForallT _ cxts (ArrowT `AppT` typ `AppT` rep) -> return (cxts, typ, rep) ArrowT `AppT` typ `AppT` rep -> return ([], typ, rep) _ -> fail "Expecting a type of the form: cxts => typ -> rep" let s = VarT (mkName "s") let lazy = Bang NoSourceUnpackedness NoSourceStrictness let newtypeMVector = newtypeInstD' ''MVector [s, typ] (NormalC mvName [(lazy, ConT ''MVector `AppT` s `AppT` rep)]) let mvCon = ConE mvName let instanceMVector = InstanceD Nothing cxts (ConT ''M.MVector `AppT` ConT ''MVector `AppT` typ) $ concat [ wrap 'M.basicLength [mv] id , wrap 'M.basicUnsafeSlice [i, n, mv] (AppE mvCon) , wrap 'M.basicOverlaps [mv, mv'] id , wrap 'M.basicUnsafeNew [n] (liftE mvCon) #if MIN_VERSION_vector(0,11,0) , wrap 'M.basicInitialize [mv] id #endif , wrap 'M.basicUnsafeReplicate [n, a] (liftE mvCon) , wrap 'M.basicUnsafeRead [mv, i] (liftE fromRep) , wrap 'M.basicUnsafeWrite [mv, i, a] id , wrap 'M.basicClear [mv] id , wrap 'M.basicSet [mv, a] id , wrap 'M.basicUnsafeCopy [mv, mv'] id , wrap 'M.basicUnsafeMove [mv, mv'] id , wrap 'M.basicUnsafeGrow [mv, n] (liftE mvCon) ] let newtypeVector = newtypeInstD' ''Vector [typ] (NormalC vName [(lazy, ConT ''Vector `AppT` rep)]) let vCon = ConE vName let instanceVector = InstanceD Nothing cxts (ConT ''G.Vector `AppT` ConT ''Vector `AppT` typ) $ concat [ wrap 'G.basicUnsafeFreeze [mv] (liftE vCon) , wrap 'G.basicUnsafeThaw [v] (liftE mvCon) , wrap 'G.basicLength [v] id , wrap 'G.basicUnsafeSlice [i, n, v] (AppE vCon) , wrap 'G.basicUnsafeIndexM [v, i] (liftE fromRep) , wrap 'G.basicUnsafeCopy [mv, v] id , wrap 'G.elemseq [v, a] id ] return [ InstanceD Nothing cxts (ConT ''Unbox `AppT` typ) [] , newtypeMVector, instanceMVector , newtypeVector, instanceVector ] newtypeInstD' :: Name -> [Type] -> Con -> Dec newtypeInstD' name args con = #if MIN_VERSION_template_haskell(2,15,0) NewtypeInstD [] Nothing (foldl AppT (ConT name) args) Nothing con [] #else NewtypeInstD [] name args Nothing con [] #endif {-$usage Writing @Unbox@ instances for new data types is tedious and formulaic. More often than not, there is a straightforward mapping of the new type onto some existing one already imbued with an @Unbox@ instance. The from the @vector@ package represents @Complex a@ as pairs @(a, a)@. Using 'derivingUnbox', we can define the same instances much more succinctly: >derivingUnbox "Complex" > [t| ∀ a. (Unbox a) ⇒ Complex a → (a, a) |] > [| \ (r :+ i) → (r, i) |] > [| \ (r, i) → r :+ i |] Requires the @MultiParamTypeClasses@, @TemplateHaskell@, @TypeFamilies@ and probably the @FlexibleInstances@ @LANGUAGE@ extensions. Note that GHC 7.4 (but not earlier nor later) needs the 'G.Vector' and 'M.MVector' class method names to be in scope in order to define the appropriate instances: >#if __GLASGOW_HASKELL__ == 704 >import qualified Data.Vector.Generic >import qualified Data.Vector.Generic.Mutable >#endif Consult the for a working example. -} vector-th-unbox-0.2.2/LICENSE0000644000000000000000000000276307346545000013765 0ustar0000000000000000Copyright (c) 2012−2015, Liyang HU 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 Liyang HU 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. vector-th-unbox-0.2.2/README.md0000644000000000000000000000013407346545000014225 0ustar0000000000000000 vector-th-unbox-0.2.2/Setup.hs0000644000000000000000000000005607346545000014405 0ustar0000000000000000import Distribution.Simple main = defaultMain vector-th-unbox-0.2.2/tests/0000755000000000000000000000000007346545000014112 5ustar0000000000000000vector-th-unbox-0.2.2/tests/sanity.hs0000644000000000000000000000127607346545000015763 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UnicodeSyntax #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Main (main) where import Prelude import Data.Default #if __GLASGOW_HASKELL__ == 704 import qualified Data.Vector.Generic import qualified Data.Vector.Generic.Mutable #endif import Data.Vector.Unboxed.Base (Unbox) import Data.Vector.Unboxed.Deriving derivingUnbox "Maybe" [t| ∀ a. (Default a, Unbox a) ⇒ Maybe a → (Bool, a) |] [| maybe (False, def) (\ x → (True, x)) |] [| \ (b, x) → if b then Just x else Nothing |] main ∷ IO () main = return () vector-th-unbox-0.2.2/vector-th-unbox.cabal0000644000000000000000000000275207346545000017006 0ustar0000000000000000name: vector-th-unbox version: 0.2.2 synopsis: Deriver for Data.Vector.Unboxed using Template Haskell description: A Template Haskell deriver for unboxed vectors, given a pair of coercion functions to and from some existing type with an Unbox instance. . Refer to "Data.Vector.Unboxed.Deriving" for documentation and examples. stability: experimental homepage: https://github.com/tsurucapital/vector-th-unbox license: BSD3 license-file: LICENSE copyright: (c) 2012-2015 Liyang HU author: Liyang HU maintainer: Fumiaki Kinoshita category: Data build-type: Simple cabal-version: >= 1.10 tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.4, GHC == 8.6.5, GHC == 8.8.3, GHC == 8.10.1, GHC == 9.0.1, GHC ==9.2.1 extra-source-files: CHANGELOG.md README.md source-repository head type: git location: http://github.com/tsurucapital/vector-th-unbox library default-language: Haskell2010 exposed-modules: Data.Vector.Unboxed.Deriving build-depends: base >= 4.5 && < 4.17, template-haskell >= 2.5 && <2.19, vector >= 0.7.1 && <0.13 test-suite sanity default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: sanity.hs build-depends: base, data-default, vector, vector-th-unbox ghc-options: -Wall -- vim: et sw=4 ts=4 sts=4: