packages feed

vector-th-unbox 0.2.0.1 → 0.2.0.2

raw patch · 3 files changed

+96/−32 lines, 3 filesdep +data-defaultdep +vector-th-unboxdep ~basedep ~vector

Dependencies added: data-default, vector-th-unbox

Dependency ranges changed: base, vector

Files

Data/Vector/Unboxed/Deriving.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TemplateHaskell #-} #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-}@@ -10,7 +11,7 @@  {-| Module:      Data.Vector.Unboxed.Deriving-Copyright:   © Liyang HU 2012+Copyright:   © 2012−2013 Liyang HU License:     BSD3 Maintainer:  vector-th-unbox@liyang.hu Stability:   experimental@@ -18,11 +19,10 @@  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 example from the-@vector@ package represents @Complex a@ as pairs @(a, a)@. (See-<http://hackage.haskell.org/packages/archive/vector/latest/doc/html/Data-Vector-Unboxed.html>.)-Using 'derivingUnbox', we can define the same instances much more-succinctly:+existing one already imbued with an @Unbox@ instance. The+<http://hackage.haskell.org/package/vector/docs/Data-Vector-Unboxed.html example>+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| (Unbox a) ⇒ Complex a → (a, a) |]@@ -30,12 +30,17 @@ >    [| \ (r, i) → r :+ i |]  Requires the @MultiParamTypeClasses@, @TemplateHaskell@, @TypeFamilies@ and-probably the @FlexibleInstances@ @LANGUAGE@ extensions. Older versions of-GHC needs the 'G.Vector' and 'M.MVector' class method names in scope:+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 <https://github.com/liyang/vector-th-unbox/blob/master/tests/sanity.hs sanity test>+for a working example. -}  module Data.Vector.Unboxed.Deriving (derivingUnbox) where@@ -48,30 +53,55 @@ import Data.Vector.Unboxed.Base (MVector (..), Vector (..), Unbox) import Language.Haskell.TH +consUnbox :: String -> (Name, Name)+consUnbox name = (mkName $ "MV_" ++ name, mkName $ "V_" ++ name)+ -- 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+    let (mvName, vName) = consUnbox 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+capture = mkName . nameBase++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 fun Inline FunLike AllPhases)+    inline = PragmaD (InlineP name Inline FunLike AllPhases) #else-    inline = PragmaD ( InlineP (mkName (nameBase fun))-        (InlineSpec True False Nothing) )+    inline = PragmaD ( InlineP name (InlineSpec True False Nothing) ) #endif     body = coerce $ foldl AppE (VarE fun) exps-    method = FunD fun [Clause pats (NormalB body) []]+    method = FunD name [Clause pats (NormalB body) []]  {-| Let's consider a more complex example: suppose we want an @Unbox@-instance for @Maybe a@. We can 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 @Default@ (see the @data-default@ package) constraint. Thus:+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 <http://hackage.haskell.org/package/data-default/docs/Data-Default.html#t:Default Default>+constraint. Thus:  >derivingUnbox "Maybe" >    [t| (Default a, Unbox a) ⇒ Maybe a → (Bool, a) |]@@ -85,29 +115,20 @@     -> 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-    let mvName = mkName ("MV_" ++ name)-    let vName  = mkName ("V_" ++ name)+    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 liftE e = InfixE (Just e) (VarE 'liftM) . Just-    let mvCon = ConE mvName-    let vCon  = ConE vName-    i <- newPatExp "idx"-    n <- newPatExp "len"-    a <- second (AppE toRep) <$> newPatExp "val"-    mv  <- first (ConP mvName . (:[])) <$> newPatExp "mvec"-    mv' <- first (ConP mvName . (:[])) <$> newPatExp "mvec'"-    v   <- first (ConP vName  . (:[])) <$> newPatExp "vec"-     s <- VarT <$> newName "s"     let newtypeMVector = NewtypeInstD [] ''MVector [s, typ]             (NormalC mvName [(NotStrict, ConT ''MVector `AppT` s `AppT` rep)]) []+    let mvCon = ConE mvName     let instanceMVector = InstanceD cxts             (ConT ''M.MVector `AppT` ConT ''MVector `AppT` typ) $ concat             [ wrap 'M.basicLength           [mv]        id@@ -120,10 +141,12 @@             , 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 [(NotStrict, ConT ''Vector `AppT` rep)]) []+    let vCon  = ConE vName     let instanceVector = InstanceD cxts             (ConT ''G.Vector `AppT` ConT ''Vector `AppT` typ) $ concat             [ wrap 'G.basicUnsafeFreeze     [mv]        (liftE vCon)
+ tests/sanity.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE UnicodeSyntax #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 706+{-# OPTIONS_GHC -fno-warn-unused-imports #-}+#endif++module Main (main) where++import Prelude+import Data.Default+import qualified Data.Vector.Generic+import qualified Data.Vector.Generic.Mutable+import Data.Vector.Unboxed.Base (Unbox)+import Data.Vector.Unboxed.Deriving++derivingUnbox "Maybe"+    [t| (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.cabal view
@@ -1,5 +1,5 @@ name:           vector-th-unbox-version:        0.2.0.1+version:        0.2.0.2 synopsis:       Deriver for Data.Vector.Unboxed using Template Haskell description:     A Template Haskell deriver for unboxed vectors, given a pair of coercion@@ -9,17 +9,19 @@ stability:      experimental license:        BSD3 license-file:   LICENSE-author:         Liyang HU-maintainer:     vector-th-unbox@liyang.hu+copyright:      © 2012−2013 Liyang HU+author:         Liyang HU <vector-th-unbox@liyang.hu>+maintainer:     Liyang HU <vector-th-unbox@liyang.hu> category:       Data build-type:     Simple-cabal-version:  >= 1.6+cabal-version:  >= 1.10  source-repository head     type:       git     location:   http://github.com/liyang/vector-th-unbox  library+    default-language: Haskell2010     exposed-modules:         Data.Vector.Unboxed.Deriving @@ -27,6 +29,18 @@         base >= 4.3 && < 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: