memoize-1.1.2/0000755000000000000000000000000007346545000011351 5ustar0000000000000000memoize-1.1.2/CHANGELOG.md0000644000000000000000000000160507346545000013164 0ustar0000000000000000# Change Log ## [1.1.2] - 2022-09-16 - fix severe slowness in `Memoizable Integer` instance (h/t @darrenks) - correct minimum `base` version (h/t @Bodigrim) ## [1.1.1] - 2021-10-31 - add this changelog to `memoize.cabal` ## [1.1.0] - 2021-10-31 - add `Memoizable` instances for types from `base`: - `Data.Complex.Complex` - `Data.Ratio.Ratio` - `Data.Tuple.Solo` - `Data.Version.Version` - `Data.Void.Void` - fix misspelling of “little-endian” in docs ## [1.0.0] - 2021-10-27 - support GHC 9 ## [0.8.0] - 2016-09-03 - support GHC 8 and `template-haskell` 2.11.0 ## [0.7.0] - 2015-03-30 - support GHC 7.10 ## [0.6.0] - 2014-04-01 - support GHC 7.6 ## [0.4.0] - 2014-04-01 - prevent use of `template-haskell` 3 ## [0.3.0] - 2012-03-12 - support GHC 7.4 ## [0.2.0] - 2012-03-06 - fix: arithmetic overflow in memoization on `Int` ## [0.1.0] - 2011-07-11 - initialize release memoize-1.1.2/LICENSE0000644000000000000000000000274307346545000012364 0ustar0000000000000000Copyright (c) 2011–2022, Jesse A. Tov 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 the nor the names of its 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 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. memoize-1.1.2/README.md0000644000000000000000000000234607346545000012635 0ustar0000000000000000memoize ======= [![Build Status][ci badge]][ci] [![Docs][haddock badge]][haddock] [![Hackage][hackage badge]][hackage] [![License: BSD 3-Clause][license badge]][license] This library provides a type class `Memoizable` for memoizing functions, along with instances for a variety of argument types. It includes a Template Haskell function for deriving `Memoizable` instances for arbitrary algebraic datatypes. The library constructs pure memo caches without the use of `unsafePerformIO`. This technique relies on implementation assumptions—namely, *call-by-need*—that, while not guaranteed by the semantics of Haskell, generally appear to hold. [ci]: [ci badge]: [hackage]: [hackage badge]: [license]: [license badge]: [haddock]: [haddock badge]: memoize-1.1.2/Setup.hs0000644000000000000000000000011107346545000012776 0ustar0000000000000000#!/usr/bin/env runhaskell import Distribution.Simple main = defaultMain memoize-1.1.2/memoize.cabal0000644000000000000000000000361007346545000014002 0ustar0000000000000000cabal-version: 2.2 name: memoize version: 1.1.2 license: BSD-3-Clause license-file: LICENSE stability: experimental author: Jesse A. Tov maintainer: jesse.tov@gmail.com category: Data synopsis: A memoization library build-type: Simple tested-with: GHC == 9.0.1, GHC == 8.10.7, GHC == 8.6.5 description: This library provides a type class 'Memoizable' for memoizing functions, along with instances for a variety of argument types. It includes a Template Haskell function for deriving 'Memoizable' instances for arbitrary algebraic datatypes. . The library constructs pure memo caches without the use of 'unsafePerformIO'. This technique relies on implementation assumptions that, while not guaranteed by the semantics of Haskell, appear to be true. extra-source-files: README.md CHANGELOG.md library build-depends: base >=4.8 && <5, template-haskell >=2 && <3 default-language: Haskell98 ghc-options: -Wall -fno-warn-orphans hs-source-dirs: src exposed-modules: Data.Function.Memoize other-modules: Data.Function.Memoize.TH Data.Function.Memoize.Class test-suite memoize-test1 default-language: Haskell98 hs-source-dirs: test type: exitcode-stdio-1.0 main-is: test1.hs build-depends: base, memoize test-suite memoize-test2 default-language: Haskell98 hs-source-dirs: test type: exitcode-stdio-1.0 main-is: test2.hs build-depends: base, memoize test-suite memoize-test3 default-language: Haskell98 hs-source-dirs: test other-modules: Test3Helper type: exitcode-stdio-1.0 main-is: test3.hs build-depends: base, memoize source-repository head type: git location: git://github.com/tov/memoize.git memoize-1.1.2/src/Data/Function/0000755000000000000000000000000007346545000014576 5ustar0000000000000000memoize-1.1.2/src/Data/Function/Memoize.hs0000644000000000000000000002603307346545000016543 0ustar0000000000000000{-# LANGUAGE CPP, DeriveFunctor, GeneralizedNewtypeDeriving, TemplateHaskell, UnicodeSyntax #-} {- | A function memoization library. This includes a class for memoizable argument types and a Template Haskell expander for deriving instances of the class. Note that most memoization in this style relies on assumptions about the implementation of non-strictness (as laziness) that are not guaranteed by the semantics. However, it appears to work. -} module Data.Function.Memoize ( -- * Memoization class Memoizable(..), -- ** Operations -- *** Higher-arity memoize memoize2, memoize3, memoize4, memoize5, memoize6, memoize7, -- *** Memoizing open recursion memoFix, memoFix2, memoFix3, memoFix4, memoFix5, memoFix6, memoFix7, -- *** Tracing memoization traceMemoize, -- * For making instances for finite types memoizeFinite, -- * Deriving 'Memoizable' deriveMemoizable, deriveMemoizableParams, deriveMemoize, ) where #if MIN_VERSION_base(4,16,0) # define COMPAT_HAS_SOLO #endif #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif import Control.Monad import Debug.Trace import Data.Function.Memoize.Class import Data.Function.Memoize.TH import Data.Bits (shiftL, shiftR, finiteBitSize, (.&.), (.|.)) import qualified Data.Complex as Complex import qualified Data.Ratio as Ratio #ifdef COMPAT_HAS_SOLO import qualified Data.Tuple as Tuple #endif import qualified Data.Version as Version import qualified Data.Void as Void import qualified Data.Word as Word -- | Memoize a two argument function memoize2 ∷ (Memoizable a, Memoizable b) ⇒ (a → b → v) → a → b → v memoize2 v = memoize (memoize . v) -- | Memoize a three argument function memoize3 ∷ (Memoizable a, Memoizable b, Memoizable c) ⇒ (a → b → c → v) → a → b → c → v memoize3 v = memoize (memoize2 . v) -- | Memoize a four argument function memoize4 ∷ (Memoizable a, Memoizable b, Memoizable c, Memoizable d) ⇒ (a → b → c → d → v) → a → b → c → d → v memoize4 v = memoize (memoize3 . v) -- | Memoize a five argument function memoize5 ∷ (Memoizable a, Memoizable b, Memoizable c, Memoizable d, Memoizable e) ⇒ (a → b → c → d → e → v) → a → b → c → d → e → v memoize5 v = memoize (memoize4 . v) -- | Memoize a six argument function memoize6 ∷ (Memoizable a, Memoizable b, Memoizable c, Memoizable d, Memoizable e, Memoizable f) ⇒ (a → b → c → d → e → f → v) → a → b → c → d → e → f → v memoize6 v = memoize (memoize5 . v) -- | Memoize a seven argument function memoize7 ∷ (Memoizable a, Memoizable b, Memoizable c, Memoizable d, Memoizable e, Memoizable f, Memoizable g) ⇒ (a → b → c → d → e → f → g → v) → a → b → c → d → e → f → g → v memoize7 v = memoize (memoize6 . v) -- | Memoizes the least fixed point of a function. This is like -- 'Data.Function.fix', but it passes the fixed function a memoized -- version of itself, so this memoizes using all recursive calls as well. memoFix ∷ Memoizable a ⇒ ((a → v) → a → v) → a → v memoFix ff = f where f = memoize (ff f) -- | Two argument version of 'memoFix'. memoFix2 ∷ (Memoizable a, Memoizable b) ⇒ ((a → b → v) → a → b → v) → a → b → v memoFix2 ff = f where f = memoize2 (ff f) -- | Three argument version of 'memoFix'. memoFix3 ∷ (Memoizable a, Memoizable b, Memoizable c) ⇒ ((a → b → c → v) → a → b → c → v) → a → b → c → v memoFix3 ff = f where f = memoize3 (ff f) -- | Four argument version of 'memoFix'. memoFix4 ∷ (Memoizable a, Memoizable b, Memoizable c, Memoizable d) ⇒ ((a → b → c → d → v) → (a → b → c → d → v)) → a → b → c → d → v memoFix4 ff = f where f = memoize4 (ff f) -- | Five argument version of 'memoFix'. memoFix5 ∷ (Memoizable a, Memoizable b, Memoizable c, Memoizable d, Memoizable e) ⇒ ((a → b → c → d → e → v) → (a → b → c → d → e → v)) → a → b → c → d → e → v memoFix5 ff = f where f = memoize5 (ff f) -- | Six argument version of 'memoFix'. memoFix6 ∷ (Memoizable a, Memoizable b, Memoizable c, Memoizable d, Memoizable e, Memoizable f) ⇒ ((a → b → c → d → e → f → v) → (a → b → c → d → e → f → v)) → a → b → c → d → e → f → v memoFix6 ff = f where f = memoize6 (ff f) -- | Seven argument version of 'memoFix'. memoFix7 ∷ (Memoizable a, Memoizable b, Memoizable c, Memoizable d, Memoizable e, Memoizable f, Memoizable g) ⇒ ((a → b → c → d → e → f → g → v) → (a → b → c → d → e → f → g → v)) → a → b → c → d → e → f → g → v memoFix7 ff = f where f = memoize7 (ff f) -- | Give a one-argument function whose argument satisfies 'Show', -- this memoizes the function such that the argument is shown (using -- 'Debug.Trace.trace') only when the function has to be applied, as -- opposed to when the answer is available in the memo cache. traceMemoize ∷ (Memoizable a, Show a) ⇒ (a → b) → a → b traceMemoize f = memoize (\a → traceShow a (f a)) --- --- Binary-tree based memo caches --- -- Used for arbitrary types that are bounded and enumerable: data BinaryTreeCache v = BinaryTreeCache { btValue ∷ v, btLeft, btRight ∷ BinaryTreeCache v } deriving Functor --- --- Enumerable types using binary search trees --- newtype Finite a = ToFinite { fromFinite ∷ a } deriving (Eq, Bounded, Enum) instance (Bounded a, Enum a) ⇒ Memoizable (Finite a) where memoize f = finiteLookup (f <$> theFinites) -- | For finite 'Int'-like types, we use a balanced binary search tree -- indexed to every element from 'minBound' to 'maxBound' theFinites ∷ (Bounded a, Enum a) ⇒ BinaryTreeCache a theFinites = loop minBound maxBound where loop start stop = BinaryTreeCache { btValue = mean, btLeft = loop start (pred mean), btRight = loop (succ mean) stop } where mean = meanFinite start stop finiteLookup ∷ (Bounded a, Enum a) ⇒ BinaryTreeCache v → a → v finiteLookup cache0 a0 = loop start0 stop0 cache0 where start0 = fromEnum (minBound `asTypeOf` a0) stop0 = fromEnum (maxBound `asTypeOf` a0) a = fromEnum a0 loop start stop cache = let mean = meanFinite start stop in case a `compare` mean of EQ → btValue cache LT → loop start (pred mean) (btLeft cache) GT → loop (succ mean) stop (btRight cache) meanFinite ∷ (Bounded a, Enum a) ⇒ a → a → a meanFinite a b = toEnum (ia `div` 2 + ib `div` 2 + if odd ia && odd ib then 1 else 0) where ia = fromEnum a ib = fromEnum b -- | Can be used to memoize over any "finite" type satisfying -- 'Enum' and 'Bounded'. This builds a binary search tree, treating -- the memoized type as isomorphic to a range of 'Int', so it will be -- only as efficient as 'toEnum', 'fromEnum', 'succ', and 'pred'. -- -- This can be used to make instances for finite types. For example, the -- instances for 'Int' and 'Char' are declared as: -- -- @ -- instance Memoizable Int where memoize = memoizeFinite -- instance Memoizable Char where memoize = memoizeFinite -- @ memoizeFinite ∷ (Enum a, Bounded a) ⇒ (a → v) → a → v memoizeFinite f = memoize (f . fromFinite) . ToFinite instance Memoizable Int where memoize = memoizeFinite instance Memoizable Char where memoize = memoizeFinite instance Memoizable Word.Word where memoize = memoizeFinite instance Memoizable Word.Word8 where memoize = memoizeFinite instance Memoizable Word.Word16 where memoize = memoizeFinite instance Memoizable Word.Word32 where memoize = memoizeFinite instance Memoizable Word.Word64 where memoize = memoizeFinite --- --- Derived instances --- deriveMemoizable ''() deriveMemoizable ''Bool deriveMemoizable ''Ordering deriveMemoizable ''Maybe deriveMemoizable ''Either deriveMemoizable ''[] deriveMemoizable ''Complex.Complex deriveMemoizable ''Version.Version #ifdef COMPAT_HAS_SOLO deriveMemoizable ''Tuple.Solo #endif deriveMemoizable ''(,) deriveMemoizable ''(,,) deriveMemoizable ''(,,,) deriveMemoizable ''(,,,,) deriveMemoizable ''(,,,,,) deriveMemoizable ''(,,,,,,) deriveMemoizable ''(,,,,,,,) deriveMemoizable ''(,,,,,,,,) deriveMemoizable ''(,,,,,,,,,) deriveMemoizable ''(,,,,,,,,,,) deriveMemoizable ''(,,,,,,,,,,,) --- --- 'Integer' memoization --- instance Memoizable Integer where memoize f = memoize (f . decodeInteger) . encodeInteger encodeInteger :: Integer -> [Int] encodeInteger 0 = [] encodeInteger i | minInt <= i && i <= maxInt = [fromInteger i] encodeInteger i = fromInteger (i .&. maxInt) : encodeInteger (i `shiftR` intBits) decodeInteger :: [Int] -> Integer decodeInteger = foldr op 0 where op i i' = fromIntegral i .|. i' `shiftL` intBits intBits :: Int intBits = finiteBitSize (0 :: Int) - 1 minInt, maxInt :: Integer minInt = fromIntegral (minBound :: Int) maxInt = fromIntegral (maxBound :: Int) --- --- Functions --- instance (Eq a, Bounded a, Enum a, Memoizable b) ⇒ Memoizable (a → b) where memoize = functionLookup . theFunctions functionLookup ∷ (Eq a, Bounded a, Enum a, Memoizable b) ⇒ FunctionCache b v → (a → b) → v functionLookup cache f = fcNil (foldl fcCons cache (f <$> [minBound .. maxBound])) theFunctions ∷ (Eq a, Bounded a, Enum a, Memoizable b) ⇒ ((a → b) → v) → FunctionCache b v theFunctions f = FunctionCache { fcNil = f undefined, fcCons = memoize (\b → theFunctions (f . extend b)) } where extend b g a | a == minBound = b | otherwise = g (pred a) data FunctionCache b v = FunctionCache { fcNil ∷ v, fcCons ∷ b → FunctionCache b v } --- --- Other instances --- instance Memoizable Void.Void where memoize f = f . Void.absurd -- Data.Ratio.Ratio isn't derivable because it's an abstract type. instance (Integral a, Memoizable a) => Memoizable (Ratio.Ratio a) where memoize f = memoize (f . inj) . prj where prj r = (Ratio.numerator r, Ratio.denominator r) inj (n, d) = n Ratio.% d --- --- Example functions --- -- Memoize on 'Integer'. If memoization doesn't work, this will be -- horribly slow. _fib ∷ Integer → Integer _fib = memoFix $ \fib n → case n of 0 → 1 1 → 1 _ → fib (n - 1) + fib (n - 2) -- Memoize on a function. The use of 'trace' will indicate when -- the function is called to fill in the memo cache. _isNot ∷ (Bool → Bool) → Bool _isNot = memoize $ \f → trace "_isNot" $ f True == False && f False == True -- Memoize on a curried function! _countTrue ∷ (Bool → Bool → Bool) → Integer _countTrue = memoize $ \f → trace "_countTrue" $ toInteger (length (f <$> [False,True] <*> [False,True] >>= guard)) memoize-1.1.2/src/Data/Function/Memoize/0000755000000000000000000000000007346545000016203 5ustar0000000000000000memoize-1.1.2/src/Data/Function/Memoize/Class.hs0000644000000000000000000000055107346545000017605 0ustar0000000000000000{-# LANGUAGE UnicodeSyntax #-} {- | The 'Memoizable' type class. -} module Data.Function.Memoize.Class ( Memoizable(..) ) where -- | A memoization class. An instance @'Memoizable' T@ for some -- type @T@ means that that 'memoize' method can memoize for -- parameters of type @T@. class Memoizable a where memoize ∷ (a → v) → a → v memoize-1.1.2/src/Data/Function/Memoize/TH.hs0000644000000000000000000002415307346545000017057 0ustar0000000000000000{-# LANGUAGE TemplateHaskell, UnicodeSyntax, CPP #-} {- | Exports functions for deriving instances of 'Memoizable' using Template Haskell. The @TemplateHaskell@ language extension must be enabled to use the functions exported from this module. -} module Data.Function.Memoize.TH ( deriveMemoizable, deriveMemoizableParams, deriveMemoize, ) where #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif import Control.Monad import Language.Haskell.TH import Data.Function.Memoize.Class --- --- `#DEFINE`S FOR VERSION COMPATIBILITY --- -- GHC 7.6 changed to StarT from StarK: #if __GLASGOW_HASKELL__ >= 706 # define COMPAT_STAR StarT #else # define COMPAT_STAR StarK #endif --- TH 2.10 treats type classes like type constructors: #if MIN_VERSION_template_haskell(2,10,0) # define COMPAT_CLASS_PRED(C) (appT (conT (C)) . varT) #else # define COMPAT_CLASS_PRED(C) (classP (C) . (:[]) . varT) #endif -- TH 2.11 supports GADTs and adds a field to NewtypeD and DataD: #if MIN_VERSION_template_haskell(2,11,0) # define COMPAT_TH_GADTS # define COMPAT_NEWTYPE_D(N, T, C) (NewtypeD _ (N) (T) _ (C) _) # define COMPAT_DATA_D(N, T, C) (DataD _ (N) (T) _ (C) _) #else # undef COMPAT_TH_GADTS # define COMPAT_NEWTYPE_D(N, T, C) (NewtypeD _ (N) (T) (C) _) # define COMPAT_DATA_D(N, T, C) (DataD _ (N) (T) (C) _) #endif -- GHC 9 adds a type parameter to the TyVarBndr type: #if __GLASGOW_HASKELL__ >= 900 # define COMPAT_TY_VAR_BNDR(V) (TyVarBndr (V)) # define COMPAT_PLAIN_TV(N) (PlainTV (N) _) # define COMPAT_KINDED_TV(N, K) (KindedTV (N) _ (K)) #else # define COMPAT_TY_VAR_BNDR(V) TyVarBndr # define COMPAT_PLAIN_TV(N) (PlainTV (N)) # define COMPAT_KINDED_TV(N, K) (KindedTV (N) (K)) #endif -- | -- To derive 'Memoizable' instances for the given data types. -- In the simplest usage, to derive 'Memoizable' for an algebraic -- datatype named @T@, write: -- -- @ -- deriveMemoizable ''T -- @ -- -- This assumes that all the type parameters of @T@ that are not -- annotated with a kind other than @*@ should be listed as requiring -- 'Memoizable' instances in the instance context. For example, given -- a data type declared as -- -- @ -- data T a (b :: * -> *) c = ... -- @ -- -- the generated instance will look like -- -- @ -- instance ('Memoizable' a, 'Memoizable' c) => -- 'Memoizable' (T a b c) where ... -- @ -- -- For more precise control over the context, use -- 'deriveMemoizableParams'. -- -- N.B.: The @TemplateHaskell@ language extension must be enabled to use -- this function. deriveMemoizable ∷ Name → Q [Dec] deriveMemoizable n = deriveMemoizable' n Nothing -- | -- Like 'deriveMemoizable' but takes a second argument, which is a list -- of 'Int's to specify which type parameters of the type should be -- mentioned in the context. For example, given the same definition for -- @T@ as above, we can write -- -- @ -- deriveMemoizableParams ''T [3] -- @ -- -- to leave the first parameter of @T@ out of the context and show -- only the third, yielding the instance -- -- @ -- instance 'Memoizable' c => 'Memoizable' (T a b c) where ... -- @ -- -- N.B.: The @TemplateHaskell@ language extension must be enabled to use -- this function. deriveMemoizableParams ∷ Name → [Int] → Q [Dec] deriveMemoizableParams n indices = deriveMemoizable' n (Just indices) -- | In cases where neither 'deriveMemoizable' nor -- 'deriveMemoizableParams' can figure out the right context for an -- instance declaration, one can declare the instance manually and use -- this function to derive the method body for 'memoize'. For example, -- suppose that a data type @T@ is defined as: -- -- @ -- data T a b = T (a -> Bool) b -- @ -- -- For @T a b@ to be memoizable, @a -> Bool@ must be, and based on the -- instance for '(->)', this means that @a@ must satisfy -- 'Bounded' and 'Enum', so 'deriveMemoizable' cannot build the right -- context for the 'Memoizable' instance. Instead, one can write: -- -- @ -- instance ('Eq' a, 'Enum' a, 'Bounded' a, 'Memoizable' b) => -- 'Memoizable' (T a b) where -- memoize = $(deriveMemoize ''T) -- @ deriveMemoize ∷ Name → ExpQ deriveMemoize name0 = do (_, _, cons) ← checkName name0 buildMethodExp cons -- | The main entry point delegates to check given type name, renames type -- parameters, and generates the instance. deriveMemoizable' ∷ Name → Maybe [Int] → Q [Dec] deriveMemoizable' name0 mindices = do (name, tvbs, cons) ← checkName name0 let tvs = freshNames tvbs inst ← instanceD (buildContext mindices tvbs tvs) (buildHead name tvs) [buildMethodDec cons] return [inst] -- | Given the type name for the requested instance, checks if it -- corresponds to a @data@ or @newtype@, and if so, returns the name, -- a list of its parameters, and a list of constructor names with -- their arities. checkName ∷ Name → Q (Name, [COMPAT_TY_VAR_BNDR(())], [(Name, Int)]) checkName name0 = do let can'tDerive = "deriveMemoizable: Can’t derive a Memoizable " ++ "instance for ‘" ++ show name0 ++ "’ because " can'tDeriveNonTC = can'tDerive ++ "it isn’t a type constructor." can'tDeriveGadt = can'tDerive ++ "GADTs aren’t supported." -- stdizeCon (NormalC name params) = return (name, length params) stdizeCon (RecC name fields) = return (name, length fields) stdizeCon (InfixC _ name _) = return (name, 2) stdizeCon (ForallC _ _ con) = stdizeCon con #ifdef COMPAT_TH_GADTS stdizeCon (GadtC _ _ _) = fail can'tDeriveGadt stdizeCon (RecGadtC _ _ _) = fail can'tDeriveGadt #endif -- info ← reify name0 case info of TyConI (COMPAT_DATA_D(name, tvbs, cons)) → do conInfos ← mapM stdizeCon cons return (name, tvbs, conInfos) TyConI (COMPAT_NEWTYPE_D(name, tvbs, con)) → do conInfo ← stdizeCon con return (name, tvbs, [conInfo]) _ → fail can'tDeriveNonTC -- | Given a list, produces a list of nicely printable, distinct names. -- Used so that instances print with nice parameters names, like -- -- @ -- instance Memoizable (T a b c) where -- @ -- -- instead of -- -- @ -- instance Memoizable (T a[1] b[2] c32424534) where -- @ freshNames ∷ [a] → [Name] freshNames xs = take (length xs) alphabet where alphabet = [ mkName (c:s) | s ← "" : (show <$> [1 ∷ Integer ..]) , c ← ['a' .. 'z'] ] -- | Build the type class instance context, give the necessary -- information to select which parameters to include. If the first -- argument is @Just ixs@, then there should be 'Memoizable' instances -- for exactly those parameters, by index, in the context. Otherwise, -- choose the parameters that have no explicit kind from the -- list of binders. The third argument gives the actual type variable -- names to use. buildContext ∷ Maybe [Int] → [COMPAT_TY_VAR_BNDR(a)] → [Name] → CxtQ buildContext mindices tvbs tvs = cxt (COMPAT_CLASS_PRED(''Memoizable) <$> cxttvs) where cxttvs = case mindices of Just ixs → filterBy (`elem` ixs) [1 ..] tvs Nothing → filterBy isStar tvbs tvs -- isStar (COMPAT_PLAIN_TV(_)) = True isStar (COMPAT_KINDED_TV(_, COMPAT_STAR)) = True isStar _ = False -- filterBy ∷ (a → Bool) → [a] → [b] → [b] filterBy p xs ys = snd <$> filter (p . fst) (zip xs ys) -- | Build the 'Memoizable' instance head for the given type name -- and parameter type variables. buildHead ∷ Name → [Name] → TypeQ buildHead name tvs = appT (conT ''Memoizable) (foldl appT (conT name) (varT <$> tvs)) -- | Build the 'memoize' method. The form of 'memoize' is always -- -- @ -- memoize f = lookup where -- cache1 = memoize $ \x1 -> ... memoize $ \x(a1) -> f (C1 x1 ...) -- ... -- cacheN = memoize $ \x1 -> ... memoize $ \x(aN) -> f (CN x1 ...) -- lookup (C1 x1 ...) = cache1 x1 ... -- ... -- lookup (CN xN ...) = cacheN xN ... -- @ -- -- where @C1@ ... @CN@ are the constructors of the data type and -- @aj@ is the arity of constructor @Cj@. -- -- In this method, we allocate fresh names for the parameter @f@, the -- lookup function, and the @N@ caches. We then delegate to build -- the definitions of @look@ and the caches. buildMethodDec ∷ [(Name, Int)] → DecQ buildMethodDec cons = do valD (varP 'memoize) (normalB (buildMethodExp cons)) [] -- | Build the body of the 'memoize' method, as described in the comment -- above 'buildMethodDec' buildMethodExp ∷ [(Name, Int)] → ExpQ buildMethodExp cons = do f ← newName "fun" caches ← mapM (\_ → newName "cache") cons lam1E (varP f) (letE (zipWith (buildCache f) cons caches) (buildLookup cons caches)) -- | Build the look function by building a clause for each constructor -- of the datatype. buildLookup ∷ [(Name, Int)] → [Name] → ExpQ buildLookup cons caches = do a ← newName "arg" lam1E (varP a) . caseE (varE a) $ zipWith buildLookupMatch cons caches -- | Build a lookup clause for one constructor. We lookup a value -- by matching that constructor and then passing its parameters to -- the cache for that constructor. buildLookupMatch ∷ (Name, Int) → Name → MatchQ buildLookupMatch (con, arity) cache = do params ← replicateM arity (newName "param") match (conP con (varP <$> params)) (normalB (foldl appE (varE cache) (varE <$> params))) [] -- | Build the definition of a cache for the given constructor. We do -- this by binding the cache name to a cascading sequence of -- memoizations for each component in the constructor's arity. buildCache ∷ Name → (Name, Int) → Name → DecQ buildCache f (con, arity) cache = valD (varP cache) (normalB (composeMemos arity f (conE con))) [] -- | Given the remaining arity to memoize, the name of the function to -- memoize, and the accumulated parameter so far, build the -- memoization chain. composeMemos ∷ Int → Name → ExpQ → ExpQ composeMemos 0 f arg = [| $(varE f) $arg |] composeMemos arity f arg = do [| memoize $ \b → $(composeMemos (arity - 1) f [| $arg b |]) |] memoize-1.1.2/test/0000755000000000000000000000000007346545000012330 5ustar0000000000000000memoize-1.1.2/test/Test3Helper.hs0000644000000000000000000000012707346545000015026 0ustar0000000000000000module Test3Helper where data NonstandardParams a b = NonstandardParams (a -> Bool) b memoize-1.1.2/test/test1.hs0000644000000000000000000000045007346545000013723 0ustar0000000000000000import Data.Function.Memoize import Data.Function (fix) -- for comparison main = print $ let fib :: Integer -> Integer fib = memoFix $ \ f -> \ x -> if x < 2 then x else f (x-1) + f (x-2) -- and it would take much longer with fib = fix $ \ f -> ... in take 100 $ map fib [0..] memoize-1.1.2/test/test2.hs0000644000000000000000000000072307346545000013727 0ustar0000000000000000{-# language TemplateHaskell #-} import Data.Function.Memoize import Data.Function ( fix ) data List a = Nil | Cons a (List a) $(deriveMemoizable ''List) main = print $ let lcs = memoFix2 -- exponential time if you put fix here $ \ f -> \ a b -> case (a,b) of (Cons x a', Cons y b') -> maximum [ if x == y then 1 + f a' b' else 0, f a b', f a' b ] _ -> 0 a = iterate (Cons ()) Nil !! 20 in lcs a a memoize-1.1.2/test/test3.hs0000644000000000000000000000210507346545000013724 0ustar0000000000000000{-# language TemplateHaskell, GADTs #-} import Data.Function.Memoize import Control.Monad (forM_, when) import Test3Helper -- NonstandardParams is defined by: -- -- data NonstandardParams a b -- = NonstandardParams (a -> Bool) b -- -- This won’t compile because it needs addition typeclass constraints in -- the instance context: -- -- $(deriveMemoizable ''NonstandardParams) instance (Eq a, Enum a, Bounded a, Memoizable b) => Memoizable (NonstandardParams a b) where memoize = $(deriveMemoize ''NonstandardParams) applyToLength :: NonstandardParams Bool Int -> Bool applyToLength (NonstandardParams f z) = f (odd z) cases = [ (NonstandardParams id 5, True) , (NonstandardParams id 6, False) , (NonstandardParams not 5, False) , (NonstandardParams not 6, True) ] main :: IO () main = do let memoized = memoize applyToLength forM_ cases $ \(input, expected) -> do let actual = applyToLength input when (actual /= expected) $ fail $ "Test failed: got " ++ show actual ++ " when " ++ show expected ++ " expected."