Baked-in Storable Vectors Mark II

Bake.hs

{-# LANGUAGE MagicHash, TupleSections, TemplateHaskell #-}

module Data.Vector.Storable.Bake(bake, unsafeFromAddrLen) where

import Data.Typeable
import qualified Data.Vector.Storable as VS
import Foreign
import GHC.Prim
import GHC.Ptr
import Language.Haskell.TH
import Language.Haskell.TH.Syntax
import System.IO.Unsafe

-- | Bakes a given `Vector` into the binary.
bake :: (Storable a, Typeable a) => VS.Vector a -> Q Exp
bake xs = [|unsafeFromAddrLen $(str) $(len) :: VS.Vector $(a)|]
  where
    str = litE $ StringPrimL $ VS.toList $ VS.unsafeCast xs
    len = lift $ VS.length xs
    a = conT $ typeRepToName $ typeRep xs

-- | Make a `Storable` `VS.Vector` from an `Addr#` and a length. Very unsafe.
unsafeFromAddrLen :: Storable a => Addr# -> Int -> VS.Vector a
unsafeFromAddrLen addr
  = VS.unsafeFromForeignPtr0 (unsafePerformIO (newForeignPtr_ (Ptr addr))) 

-- | Convert a `TypeRep` to a Template Haskell `Name`.
typeRepToName :: TypeRep -> Name
typeRepToName rep
  = Name (mkOccName $ tyConName tc) $
      NameG TcClsName
       (mkPkgName $ tyConPackage tc)
       (mkModName $ tyConModule tc)
  where tc = typeRepTyCon rep