vector-th-unbox-0.2.1.6/0000755000000000000000000000000012706604334013115 5ustar0000000000000000vector-th-unbox-0.2.1.6/LICENSE0000644000000000000000000000276312706604334014132 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.1.6/Setup.hs0000644000000000000000000000005612706604334014552 0ustar0000000000000000import Distribution.Simple main = defaultMain vector-th-unbox-0.2.1.6/vector-th-unbox.cabal0000644000000000000000000000252012706604334017144 0ustar0000000000000000name: vector-th-unbox version: 0.2.1.6 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 license: BSD3 license-file: LICENSE copyright: © 2012−2015 Liyang HU author: Liyang HU maintainer: Liyang HU category: Data build-type: Simple cabal-version: >= 1.10 tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 7.10.3, GHC >= 8.0 && < 8.2 source-repository head type: git location: http://github.com/liyang/vector-th-unbox library default-language: Haskell2010 exposed-modules: Data.Vector.Unboxed.Deriving build-depends: base >= 4.5 && < 5, template-haskell >= 2.5, vector >= 0.7 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: vector-th-unbox-0.2.1.6/Data/0000755000000000000000000000000012706604334013766 5ustar0000000000000000vector-th-unbox-0.2.1.6/Data/Vector/0000755000000000000000000000000012706604334015230 5ustar0000000000000000vector-th-unbox-0.2.1.6/Data/Vector/Unboxed/0000755000000000000000000000000012706604334016634 5ustar0000000000000000vector-th-unbox-0.2.1.6/Data/Vector/Unboxed/Deriving.hs0000644000000000000000000001703012706604334020740 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RecordWildCards #-} #if __GLASGOW_HASKELL__ >= 800 {-# LANGUAGE TemplateHaskellQuotes #-} #else {-# LANGUAGE TemplateHaskell #-} #endif #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif {-# 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 #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif 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 (ConP mvName . (:[])) <$> newPatExp "mvec" mv' <- first (ConP mvName . (:[])) <$> newPatExp "mvec'" v <- first (ConP vName . (:[])) <$> newPatExp "vec" return Common {..} -- Turn any 'Name' into a capturable one. capture :: Name -> Name #if __GLASGOW_HASKELL__ == 704 capture = mkName . nameBase #else capture = id #endif 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 fun (unzip -> (pats, exps)) coerce = [inline, method] where name = capture fun #if MIN_VERSION_template_haskell(2,8,0) inline = PragmaD (InlineP name Inline FunLike AllPhases) #else inline = PragmaD ( InlineP name (InlineSpec True False Nothing) ) #endif body = coerce $ foldl AppE (VarE fun) 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") #if MIN_VERSION_template_haskell(2,11,0) let lazy = Bang NoSourceUnpackedness NoSourceStrictness # define MAYBE_KIND Nothing # define MAYBE_OVERLAP Nothing #else let lazy = NotStrict # define MAYBE_KIND # define MAYBE_OVERLAP #endif let newtypeMVector = NewtypeInstD [] ''MVector [s, typ] MAYBE_KIND (NormalC mvName [(lazy, ConT ''MVector `AppT` s `AppT` rep)]) [] let mvCon = ConE mvName let instanceMVector = InstanceD MAYBE_OVERLAP 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] MAYBE_KIND (NormalC vName [(lazy, ConT ''Vector `AppT` rep)]) [] let vCon = ConE vName let instanceVector = InstanceD MAYBE_OVERLAP 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 MAYBE_OVERLAP cxts (ConT ''Unbox `AppT` typ) [] , newtypeMVector, instanceMVector , newtypeVector, instanceVector ] #undef __GLASGOW_HASKELL__ {-$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.1.6/tests/0000755000000000000000000000000012706604334014257 5ustar0000000000000000vector-th-unbox-0.2.1.6/tests/sanity.hs0000644000000000000000000000127612706604334016130 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 ()