lookup-tables (empty) → 0.1.0.0

raw patch · 6 files changed

+133/−0 lines, 6 filesdep +basedep +lookup-tablesdep +primitivesetup-changed

Dependencies added: base, lookup-tables, primitive, tasty, tasty-hunit, template-haskell

Files

• LICENSE +15/−0
• Setup.hs +2/−0
• lookup-tables.cabal +33/−0
• src/Data/LookupTable.hs +52/−0
• test/Functions.hs +9/−0
• test/Spec.hs +22/−0

@@ -0,0 +1,15 @@+Copyright (c) 2015, Jacob McArthur <Jake.McArthur@gmail.com>++Permission to use, copy, modify, and/or distribute this software for+any purpose with or without fee is hereby granted, provided that the+above copyright notice and this permission notice appear in all+copies.++THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL+WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED+WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE+AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL+DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR+PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER+TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR+PERFORMANCE OF THIS SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,33 @@+name:                lookup-tables+version:             0.1.0.0+synopsis:            Statically generate lookup tables using Template+                     Haskell.+description:         This package provides a single Template Haskell+                     function for memoizing a given function by+                     statically generating a lookup table.+license:             ISC+license-file:        LICENSE+author:              Jake McArthur+maintainer:          Jake.McArthur@gmail.com+copyright:           2015 Jacob McArthur+category:            Data+build-type:          Simple+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Data.LookupTable+  build-depends:       base             >= 4.8  && < 5,+                       primitive        >= 0.6  && < 0.7,+                       template-haskell >= 2.10 && < 2.11+  default-language:    Haskell2010+  ghc-options:         -Wall++test-suite lookup-tables-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  other-modules:       Functions+  build-depends:       base, lookup-tables, tasty, tasty-hunit+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall+  default-language:    Haskell2010

@@ -0,0 +1,52 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TemplateHaskell #-}+module Data.LookupTable (generateLUT) where++import Control.Monad+import Control.Monad.Primitive+import Data.Word+import Foreign.Marshal.Alloc+import Foreign.Ptr+import Foreign.Storable+import GHC.Ptr+import Language.Haskell.TH+import Language.Haskell.TH.Syntax++toWord8s :: Storable a => a -> IO [Word8]+toWord8s x = alloca $ \ptr -> do+  poke ptr x+  mapM (peekElemOff (castPtr ptr)) [0 .. sizeOf x - 1]++lookupTable :: (Bounded a, Enum a, Storable b) => (a -> b) -> Q Exp+lookupTable f = do+  word8ss <- runIO (mapM (toWord8s . f) [minBound .. maxBound])+  litE (stringPrimL (concat word8ss))++-- |+-- @generateLUT f@ generates an expression representing a memoized+-- version of @f@. The lookup table is generated at compile time and+-- stored directly in the final executable. The generated code is+-- unsafe if the 'Bounded' and 'Enum' instances are not law-abiding or+-- if the 'Storable' instance is crazy.+--+-- Due to the constraints of Template Haskell, the function to memoize+-- must be defined in a different module.+--+-- Example usage:+--+-- > module Foo where+-- >+-- > import Data.Word+-- > +-- > fImpl :: Word8 -> Double+-- > fImpl w8 = fromIntegral w / 255+--+-- > module Bar where+-- >+-- > import Foo+-- >+-- > f :: Word8 -> Double+-- > f = $$(generateLUT fImpl)+generateLUT :: (Bounded a, Enum a, Storable b) => (a -> b) -> Q (TExp (a -> b))+generateLUT f =+  TExp <$> [| \a -> unsafeInlineIO (peekElemOff (Ptr $(lookupTable f)) (fromEnum a - fromEnum (minBound `asTypeOf` a))) |]

@@ -0,0 +1,9 @@+module Functions where++import Data.Word++f :: Word8 -> Word8+f w = w + 100++g :: Word16 -> Double+g w = fromIntegral w / fromIntegral (maxBound :: Word16)

@@ -0,0 +1,22 @@+{-# LANGUAGE TemplateHaskell #-}+import Data.LookupTable+import Test.Tasty+import Test.Tasty.HUnit++import Functions++import Data.Word++fMemo :: Word8 -> Word8+fMemo = $$(generateLUT f)++gMemo :: Word16 -> Double+gMemo = $$(generateLUT g)++main :: IO ()+main =+  defaultMain+  (testGroup "Unit tests"+  [ testCase "Word8  -> Word8"  $ map f [minBound .. maxBound] @=? map fMemo [minBound .. maxBound]+  , testCase "Word16 -> Double" $ map g [minBound .. maxBound] @=? map gMemo [minBound .. maxBound]+  ])