{-# 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 :: forall a b v.
(Memoizable a, Memoizable b) =>
(a -> b -> v) -> a -> b -> v
memoize2 a -> b -> v
v = forall a v. Memoizable a => (a -> v) -> a -> v
memoize (forall a v. Memoizable a => (a -> v) -> a -> v
memoize forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> v
v)

-- | Memoize a three argument function
memoize3 ∷ (Memoizable a, Memoizable b, Memoizable c) ⇒
           (a → b → c → v) → a → b → c → v
memoize3 :: forall a b c v.
(Memoizable a, Memoizable b, Memoizable c) =>
(a -> b -> c -> v) -> a -> b -> c -> v
memoize3 a -> b -> c -> v
v = forall a v. Memoizable a => (a -> v) -> a -> v
memoize (forall a b v.
(Memoizable a, Memoizable b) =>
(a -> b -> v) -> a -> b -> v
memoize2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c -> v
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 :: forall a b c d v.
(Memoizable a, Memoizable b, Memoizable c, Memoizable d) =>
(a -> b -> c -> d -> v) -> a -> b -> c -> d -> v
memoize4 a -> b -> c -> d -> v
v = forall a v. Memoizable a => (a -> v) -> a -> v
memoize (forall a b c v.
(Memoizable a, Memoizable b, Memoizable c) =>
(a -> b -> c -> v) -> a -> b -> c -> v
memoize3 forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c -> d -> v
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 :: forall a b c d e v.
(Memoizable a, Memoizable b, Memoizable c, Memoizable d,
 Memoizable e) =>
(a -> b -> c -> d -> e -> v) -> a -> b -> c -> d -> e -> v
memoize5 a -> b -> c -> d -> e -> v
v = forall a v. Memoizable a => (a -> v) -> a -> v
memoize (forall a b c d v.
(Memoizable a, Memoizable b, Memoizable c, Memoizable d) =>
(a -> b -> c -> d -> v) -> a -> b -> c -> d -> v
memoize4 forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c -> d -> e -> v
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 :: forall a b c d e f v.
(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 a -> b -> c -> d -> e -> f -> v
v = forall a v. Memoizable a => (a -> v) -> a -> v
memoize (forall a b c d e v.
(Memoizable a, Memoizable b, Memoizable c, Memoizable d,
 Memoizable e) =>
(a -> b -> c -> d -> e -> v) -> a -> b -> c -> d -> e -> v
memoize5 forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c -> d -> e -> f -> v
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 :: forall a b c d e f g v.
(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 a -> b -> c -> d -> e -> f -> g -> v
v = forall a v. Memoizable a => (a -> v) -> a -> v
memoize (forall a b c d e f v.
(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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b -> c -> d -> e -> f -> g -> v
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 :: forall a v. Memoizable a => ((a -> v) -> a -> v) -> a -> v
memoFix (a -> v) -> a -> v
ff = a -> v
f where f :: a -> v
f = forall a v. Memoizable a => (a -> v) -> a -> v
memoize ((a -> v) -> a -> v
ff a -> v
f)

-- | Two argument version of 'memoFix'.
memoFix2 ∷ (Memoizable a, Memoizable b) ⇒
           ((a → b → v) → a → b → v) → a → b → v
memoFix2 :: forall a b v.
(Memoizable a, Memoizable b) =>
((a -> b -> v) -> a -> b -> v) -> a -> b -> v
memoFix2 (a -> b -> v) -> a -> b -> v
ff = a -> b -> v
f where f :: a -> b -> v
f = forall a b v.
(Memoizable a, Memoizable b) =>
(a -> b -> v) -> a -> b -> v
memoize2 ((a -> b -> v) -> a -> b -> v
ff a -> b -> v
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 :: forall a b c v.
(Memoizable a, Memoizable b, Memoizable c) =>
((a -> b -> c -> v) -> a -> b -> c -> v) -> a -> b -> c -> v
memoFix3 (a -> b -> c -> v) -> a -> b -> c -> v
ff = a -> b -> c -> v
f where f :: a -> b -> c -> v
f = forall a b c v.
(Memoizable a, Memoizable b, Memoizable c) =>
(a -> b -> c -> v) -> a -> b -> c -> v
memoize3 ((a -> b -> c -> v) -> a -> b -> c -> v
ff a -> b -> c -> v
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 :: forall a b c d v.
(Memoizable a, Memoizable b, Memoizable c, Memoizable d) =>
((a -> b -> c -> d -> v) -> a -> b -> c -> d -> v)
-> a -> b -> c -> d -> v
memoFix4 (a -> b -> c -> d -> v) -> a -> b -> c -> d -> v
ff = a -> b -> c -> d -> v
f where f :: a -> b -> c -> d -> v
f = forall a b c d v.
(Memoizable a, Memoizable b, Memoizable c, Memoizable d) =>
(a -> b -> c -> d -> v) -> a -> b -> c -> d -> v
memoize4 ((a -> b -> c -> d -> v) -> a -> b -> c -> d -> v
ff a -> b -> c -> d -> v
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 :: forall a b c d e v.
(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 (a -> b -> c -> d -> e -> v) -> a -> b -> c -> d -> e -> v
ff = a -> b -> c -> d -> e -> v
f where f :: a -> b -> c -> d -> e -> v
f = forall a b c d e v.
(Memoizable a, Memoizable b, Memoizable c, Memoizable d,
 Memoizable e) =>
(a -> b -> c -> d -> e -> v) -> a -> b -> c -> d -> e -> v
memoize5 ((a -> b -> c -> d -> e -> v) -> a -> b -> c -> d -> e -> v
ff a -> b -> c -> d -> e -> v
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 :: forall a b c d e f v.
(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 (a -> b -> c -> d -> e -> f -> v)
-> a -> b -> c -> d -> e -> f -> v
ff = a -> b -> c -> d -> e -> f -> v
f where f :: a -> b -> c -> d -> e -> f -> v
f = forall a b c d e f v.
(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 ((a -> b -> c -> d -> e -> f -> v)
-> a -> b -> c -> d -> e -> f -> v
ff a -> b -> c -> d -> e -> f -> v
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 :: forall a b c d e f g v.
(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 (a -> b -> c -> d -> e -> f -> g -> v)
-> a -> b -> c -> d -> e -> f -> g -> v
ff = a -> b -> c -> d -> e -> f -> g -> v
f where f :: a -> b -> c -> d -> e -> f -> g -> v
f = forall a b c d e f g v.
(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 ((a -> b -> c -> d -> e -> f -> g -> v)
-> a -> b -> c -> d -> e -> f -> g -> v
ff a -> b -> c -> d -> e -> f -> g -> v
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 :: forall a b. (Memoizable a, Show a) => (a -> b) -> a -> b
traceMemoize a -> b
f = forall a v. Memoizable a => (a -> v) -> a -> v
memoize (\a
a → forall a b. Show a => a -> b -> b
traceShow a
a (a -> b
f a
a))

---
--- Binary-tree based memo caches
---

-- Used for arbitrary types that are bounded and enumerable:

data BinaryTreeCache v
 = BinaryTreeCache {
    forall v. BinaryTreeCache v -> v
btValue         ∷ v,
    forall v. BinaryTreeCache v -> BinaryTreeCache v
btLeft, forall v. BinaryTreeCache v -> BinaryTreeCache v
btRight ∷ BinaryTreeCache v
   }
   deriving forall a b. a -> BinaryTreeCache b -> BinaryTreeCache a
forall a b. (a -> b) -> BinaryTreeCache a -> BinaryTreeCache b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> BinaryTreeCache b -> BinaryTreeCache a
$c<$ :: forall a b. a -> BinaryTreeCache b -> BinaryTreeCache a
fmap :: forall a b. (a -> b) -> BinaryTreeCache a -> BinaryTreeCache b
$cfmap :: forall a b. (a -> b) -> BinaryTreeCache a -> BinaryTreeCache b
Functor

---
--- Enumerable types using binary search trees
---

newtype Finite a = ToFinite { forall a. Finite a -> a
fromFinite ∷ a }
  deriving (Finite a -> Finite a -> Bool
forall a. Eq a => Finite a -> Finite a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Finite a -> Finite a -> Bool
$c/= :: forall a. Eq a => Finite a -> Finite a -> Bool
== :: Finite a -> Finite a -> Bool
$c== :: forall a. Eq a => Finite a -> Finite a -> Bool
Eq, Finite a
forall a. a -> a -> Bounded a
forall a. Bounded a => Finite a
maxBound :: Finite a
$cmaxBound :: forall a. Bounded a => Finite a
minBound :: Finite a
$cminBound :: forall a. Bounded a => Finite a
Bounded, Int -> Finite a
Finite a -> Int
Finite a -> [Finite a]
Finite a -> Finite a
Finite a -> Finite a -> [Finite a]
Finite a -> Finite a -> Finite a -> [Finite a]
forall a. Enum a => Int -> Finite a
forall a. Enum a => Finite a -> Int
forall a. Enum a => Finite a -> [Finite a]
forall a. Enum a => Finite a -> Finite a
forall a. Enum a => Finite a -> Finite a -> [Finite a]
forall a. Enum a => Finite a -> Finite a -> Finite a -> [Finite a]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Finite a -> Finite a -> Finite a -> [Finite a]
$cenumFromThenTo :: forall a. Enum a => Finite a -> Finite a -> Finite a -> [Finite a]
enumFromTo :: Finite a -> Finite a -> [Finite a]
$cenumFromTo :: forall a. Enum a => Finite a -> Finite a -> [Finite a]
enumFromThen :: Finite a -> Finite a -> [Finite a]
$cenumFromThen :: forall a. Enum a => Finite a -> Finite a -> [Finite a]
enumFrom :: Finite a -> [Finite a]
$cenumFrom :: forall a. Enum a => Finite a -> [Finite a]
fromEnum :: Finite a -> Int
$cfromEnum :: forall a. Enum a => Finite a -> Int
toEnum :: Int -> Finite a
$ctoEnum :: forall a. Enum a => Int -> Finite a
pred :: Finite a -> Finite a
$cpred :: forall a. Enum a => Finite a -> Finite a
succ :: Finite a -> Finite a
$csucc :: forall a. Enum a => Finite a -> Finite a
Enum)

instance (Bounded a, Enum a) ⇒ Memoizable (Finite a) where
  memoize :: forall v. (Finite a -> v) -> Finite a -> v
memoize Finite a -> v
f = forall a v. (Bounded a, Enum a) => BinaryTreeCache v -> a -> v
finiteLookup (Finite a -> v
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. (Bounded a, Enum a) => BinaryTreeCache a
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 :: forall a. (Bounded a, Enum a) => BinaryTreeCache a
theFinites = forall {t}. (Bounded t, Enum t) => t -> t -> BinaryTreeCache t
loop forall a. Bounded a => a
minBound forall a. Bounded a => a
maxBound where
  loop :: t -> t -> BinaryTreeCache t
loop t
start t
stop =
    BinaryTreeCache {
      btValue :: t
btValue = t
mean,
      btLeft :: BinaryTreeCache t
btLeft  = t -> t -> BinaryTreeCache t
loop t
start (forall a. Enum a => a -> a
pred t
mean),
      btRight :: BinaryTreeCache t
btRight = t -> t -> BinaryTreeCache t
loop (forall a. Enum a => a -> a
succ t
mean) t
stop
    }
    where mean :: t
mean = forall a. (Bounded a, Enum a) => a -> a -> a
meanFinite t
start t
stop

finiteLookup ∷ (Bounded a, Enum a) ⇒ BinaryTreeCache v → a → v
finiteLookup :: forall a v. (Bounded a, Enum a) => BinaryTreeCache v -> a -> v
finiteLookup BinaryTreeCache v
cache0 a
a0 =
  forall {v}. Int -> Int -> BinaryTreeCache v -> v
loop Int
start0 Int
stop0 BinaryTreeCache v
cache0 where
    start0 :: Int
start0 = forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
minBound forall a. a -> a -> a
`asTypeOf` a
a0)
    stop0 :: Int
stop0  = forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
maxBound forall a. a -> a -> a
`asTypeOf` a
a0)
    a :: Int
a      = forall a. Enum a => a -> Int
fromEnum a
a0
    loop :: Int -> Int -> BinaryTreeCache v -> v
loop Int
start Int
stop BinaryTreeCache v
cache =
      let mean :: Int
mean = forall a. (Bounded a, Enum a) => a -> a -> a
meanFinite Int
start Int
stop in
        case Int
a forall a. Ord a => a -> a -> Ordering
`compare` Int
mean of
          Ordering
EQ → forall v. BinaryTreeCache v -> v
btValue BinaryTreeCache v
cache
          Ordering
LT → Int -> Int -> BinaryTreeCache v -> v
loop Int
start (forall a. Enum a => a -> a
pred Int
mean) (forall v. BinaryTreeCache v -> BinaryTreeCache v
btLeft BinaryTreeCache v
cache)
          Ordering
GT → Int -> Int -> BinaryTreeCache v -> v
loop (forall a. Enum a => a -> a
succ Int
mean) Int
stop (forall v. BinaryTreeCache v -> BinaryTreeCache v
btRight BinaryTreeCache v
cache)

meanFinite     ∷ (Bounded a, Enum a) ⇒ a → a → a
meanFinite :: forall a. (Bounded a, Enum a) => a -> a -> a
meanFinite a
a a
b = forall a. Enum a => Int -> a
toEnum (Int
ia forall a. Integral a => a -> a -> a
`div` Int
2 forall a. Num a => a -> a -> a
+ Int
ib forall a. Integral a => a -> a -> a
`div` Int
2 forall a. Num a => a -> a -> a
+
                           if forall a. Integral a => a -> Bool
odd Int
ia Bool -> Bool -> Bool
&& forall a. Integral a => a -> Bool
odd Int
ib then Int
1 else Int
0)
  where
    ia :: Int
ia = forall a. Enum a => a -> Int
fromEnum a
a
    ib :: Int
ib = forall a. Enum a => a -> Int
fromEnum a
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 :: forall a v. (Enum a, Bounded a) => (a -> v) -> a -> v
memoizeFinite a -> v
f = forall a v. Memoizable a => (a -> v) -> a -> v
memoize (a -> v
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Finite a -> a
fromFinite) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Finite a
ToFinite

instance Memoizable Int where memoize :: forall v. (Int -> v) -> Int -> v
memoize = forall a v. (Enum a, Bounded a) => (a -> v) -> a -> v
memoizeFinite
instance Memoizable Char where memoize :: forall v. (Char -> v) -> Char -> v
memoize = forall a v. (Enum a, Bounded a) => (a -> v) -> a -> v
memoizeFinite
instance Memoizable Word.Word where memoize :: forall v. (Word -> v) -> Word -> v
memoize = forall a v. (Enum a, Bounded a) => (a -> v) -> a -> v
memoizeFinite
instance Memoizable Word.Word8 where memoize :: forall v. (Word8 -> v) -> Word8 -> v
memoize = forall a v. (Enum a, Bounded a) => (a -> v) -> a -> v
memoizeFinite
instance Memoizable Word.Word16 where memoize :: forall v. (Word16 -> v) -> Word16 -> v
memoize = forall a v. (Enum a, Bounded a) => (a -> v) -> a -> v
memoizeFinite
instance Memoizable Word.Word32 where memoize :: forall v. (Word32 -> v) -> Word32 -> v
memoize = forall a v. (Enum a, Bounded a) => (a -> v) -> a -> v
memoizeFinite
instance Memoizable Word.Word64 where memoize :: forall v. (Word64 -> v) -> Word64 -> v
memoize = forall a v. (Enum a, Bounded a) => (a -> v) -> a -> v
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 :: forall v. (Integer -> v) -> Integer -> v
memoize Integer -> v
f = forall a v. Memoizable a => (a -> v) -> a -> v
memoize (Integer -> v
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Integer
decodeInteger) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> [Int]
encodeInteger

encodeInteger :: Integer -> [Int]
encodeInteger :: Integer -> [Int]
encodeInteger Integer
0 = []
encodeInteger Integer
i | Integer
minInt forall a. Ord a => a -> a -> Bool
<= Integer
i Bool -> Bool -> Bool
&& Integer
i forall a. Ord a => a -> a -> Bool
<= Integer
maxInt
                = [forall a. Num a => Integer -> a
fromInteger Integer
i]
encodeInteger Integer
i = forall a. Num a => Integer -> a
fromInteger (Integer
i forall a. Bits a => a -> a -> a
.&. Integer
maxInt) forall a. a -> [a] -> [a]
: Integer -> [Int]
encodeInteger (Integer
i forall a. Bits a => a -> Int -> a
`shiftR` Int
intBits)

decodeInteger :: [Int] -> Integer
decodeInteger :: [Int] -> Integer
decodeInteger  = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall {a} {a}. (Bits a, Integral a, Num a) => a -> a -> a
op Integer
0 where
  op :: a -> a -> a
op a
i a
i' = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
i forall a. Bits a => a -> a -> a
.|. a
i' forall a. Bits a => a -> Int -> a
`shiftL` Int
intBits

intBits :: Int
intBits :: Int
intBits  = forall b. FiniteBits b => b -> Int
finiteBitSize (Int
0 :: Int) forall a. Num a => a -> a -> a
- Int
1

minInt, maxInt :: Integer
minInt :: Integer
minInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
minBound :: Int)
maxInt :: Integer
maxInt = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bounded a => a
maxBound :: Int)

---
--- Functions
---

instance (Eq a, Bounded a, Enum a, Memoizable b) ⇒ Memoizable (a → b) where
  memoize :: forall v. ((a -> b) -> v) -> (a -> b) -> v
memoize = forall a b v.
(Eq a, Bounded a, Enum a, Memoizable b) =>
FunctionCache b v -> (a -> b) -> v
functionLookup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b v.
(Eq a, Bounded a, Enum a, Memoizable b) =>
((a -> b) -> v) -> FunctionCache b v
theFunctions

functionLookup ∷ (Eq a, Bounded a, Enum a, Memoizable b) ⇒
                 FunctionCache b v → (a → b) → v
functionLookup :: forall a b v.
(Eq a, Bounded a, Enum a, Memoizable b) =>
FunctionCache b v -> (a -> b) -> v
functionLookup FunctionCache b v
cache a -> b
f =
  forall b v. FunctionCache b v -> v
fcNil (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall b v. FunctionCache b v -> b -> FunctionCache b v
fcCons FunctionCache b v
cache (a -> b
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [forall a. Bounded a => a
minBound .. forall a. Bounded a => a
maxBound]))

theFunctions ∷ (Eq a, Bounded a, Enum a, Memoizable b) ⇒
               ((a → b) → v) → FunctionCache b v
theFunctions :: forall a b v.
(Eq a, Bounded a, Enum a, Memoizable b) =>
((a -> b) -> v) -> FunctionCache b v
theFunctions (a -> b) -> v
f =
  FunctionCache {
    fcNil :: v
fcNil  = (a -> b) -> v
f forall a. HasCallStack => a
undefined,
    fcCons :: b -> FunctionCache b v
fcCons = forall a v. Memoizable a => (a -> v) -> a -> v
memoize (\b
b → forall a b v.
(Eq a, Bounded a, Enum a, Memoizable b) =>
((a -> b) -> v) -> FunctionCache b v
theFunctions ((a -> b) -> v
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {t} {p}.
(Eq t, Bounded t, Enum t) =>
p -> (t -> p) -> t -> p
extend b
b))
  }
    where
      extend :: p -> (t -> p) -> t -> p
extend p
b t -> p
g t
a
        | t
a forall a. Eq a => a -> a -> Bool
== forall a. Bounded a => a
minBound = p
b
        | Bool
otherwise     = t -> p
g (forall a. Enum a => a -> a
pred t
a)

data FunctionCache b v
  = FunctionCache {
      forall b v. FunctionCache b v -> v
fcNil  ∷ v,
      forall b v. FunctionCache b v -> b -> FunctionCache b v
fcCons ∷ b → FunctionCache b v
    }


---
--- Other instances
---

instance Memoizable Void.Void where
  memoize :: forall v. (Void -> v) -> Void -> v
memoize Void -> v
f = Void -> v
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Void -> a
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 :: forall v. (Ratio a -> v) -> Ratio a -> v
memoize Ratio a -> v
f = forall a v. Memoizable a => (a -> v) -> a -> v
memoize (Ratio a -> v
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. Integral a => (a, a) -> Ratio a
inj) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {b}. Ratio b -> (b, b)
prj
    where
      prj :: Ratio b -> (b, b)
prj Ratio b
r      = (forall a. Ratio a -> a
Ratio.numerator Ratio b
r, forall a. Ratio a -> a
Ratio.denominator Ratio b
r)
      inj :: (a, a) -> Ratio a
inj (a
n, a
d) = a
n forall a. Integral a => a -> a -> Ratio a
Ratio.% a
d


---
--- Example functions
---

-- Memoize on 'Integer'. If memoization doesn't work, this will be
-- horribly slow.
_fib ∷ Integer → Integer
_fib :: Integer -> Integer
_fib = forall a v. Memoizable a => ((a -> v) -> a -> v) -> a -> v
memoFix forall a b. (a -> b) -> a -> b
$ \Integer -> Integer
fib Integer
n → case Integer
n of
  Integer
0 → Integer
1
  Integer
1 → Integer
1
  Integer
_ → Integer -> Integer
fib (Integer
n forall a. Num a => a -> a -> a
- Integer
1) forall a. Num a => a -> a -> a
+ Integer -> Integer
fib (Integer
n forall a. Num a => a -> a -> a
- Integer
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 :: (Bool -> Bool) -> Bool
_isNot       = forall a v. Memoizable a => (a -> v) -> a -> v
memoize forall a b. (a -> b) -> a -> b
$ \Bool -> Bool
f →
  forall a. String -> a -> a
trace String
"_isNot" forall a b. (a -> b) -> a -> b
$
    Bool -> Bool
f Bool
True forall a. Eq a => a -> a -> Bool
== Bool
False Bool -> Bool -> Bool
&& Bool -> Bool
f Bool
False forall a. Eq a => a -> a -> Bool
== Bool
True

-- Memoize on a curried function!
_countTrue ∷ (Bool → Bool → Bool) → Integer
_countTrue :: (Bool -> Bool -> Bool) -> Integer
_countTrue = forall a v. Memoizable a => (a -> v) -> a -> v
memoize forall a b. (a -> b) -> a -> b
$ \Bool -> Bool -> Bool
f →
  forall a. String -> a -> a
trace String
"_countTrue" forall a b. (a -> b) -> a -> b
$
    forall a. Integral a => a -> Integer
toInteger (forall (t :: * -> *) a. Foldable t => t a -> Int
length (Bool -> Bool -> Bool
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bool
False,Bool
True] forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Bool
False,Bool
True] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (f :: * -> *). Alternative f => Bool -> f ()
guard))