{-# LANGUAGE UndecidableInstances #-}

module Control.Monad.Memoize
  ( MonadMemoize (..),
    memoize,
    MemoizeT,
    runMemoizeT,
  )
where

import Control.Monad.Except
import Control.Monad.Reader (MonadReader, ReaderT, mapReaderT)
import Control.Monad.State.Strict (MonadState (..), StateT, evalStateT)
import Data.Dependent.Map (DMap)
import Data.Dependent.Map qualified as DM
import Data.Functor.Identity
import Data.GADT.Compare.Extended
import Data.IORef
import Data.Kind qualified as K
import Language.Haskell.TH qualified as TH
import System.IO.Unsafe (unsafeInterleaveIO)
import Type.Reflection (Typeable, typeRep)
import Prelude

{- Note [Tying the knot]
~~~~~~~~~~~~~~~~~~~~~~~~
GraphQL type definitions can be mutually recursive, and indeed, they quite often
are! For example, two tables that reference one another will be represented by
types such as the following:

    type author {
      id: Int!
      name: String!
      articles: [article!]!
    }

    type article {
      id: Int!
      title: String!
      content: String!
      author: author!
    }

This doesn’t cause any trouble if the schema is represented by a mapping from
type names to type definitions, but the Parser abstraction is all about avoiding
that kind of indirection to improve type safety — parsers refer to their
sub-parsers directly. This presents two problems during schema generation:

  1. Schema generation needs to terminate in finite time, so we need to ensure
     we don’t try to eagerly construct an infinitely-large schema due to the
     mutually-recursive structure.

  2. To serve introspection queries, we do eventually need to construct a
     mapping from names to types (a TypeMap), so we need to be able to
     recursively walk the entire schema in finite time.

Solving point number 1 could be done with either laziness or sharing, but
neither of those are enough to solve point number 2, which requires /observable/
sharing. We need to construct a Parser graph that contains enough information to
detect cycles during traversal.

It may seem appealing to just use type names to detect cycles, which would allow
us to get away with using laziness rather than true sharing. Unfortunately, that
leads to two further problems:

  * It’s possible to end up with two different types with the same name, which
    is an error and should be reported as such. Using names to break cycles
    prevents us from doing that, since we have no way to check that two types
    with the same name are actually the same.

  * Some Parser constructors can fail — the `column` parser checks that the type
    name is a valid GraphQL name, for example. This extra validation means lazy
    schema construction isn’t viable, since we need to eagerly build the schema
    to ensure all the validation checks hold.

So we’re forced to use sharing. But how do we do it? Somehow, we have to /tie
the knot/ — we have to build a cyclic data structure — and some of the cycles
may be quite large. Doing all this knot-tying by hand would be incredibly
tricky, and it would require a lot of inversion of control to thread the shared
parsers around.

To avoid contorting the program, we instead implement a form of memoization. The
MonadMemoize class provides a mechanism to memoize a parser constructor function,
which allows us to get sharing mostly for free. The memoization strategy also
annotates cached parsers with a Unique that can be used to break cycles while
traversing the graph, so we get observable sharing as well. -}

class (Monad m) => MonadMemoize m where
  -- | Memoizes a parser constructor function for the extent of a single schema
  -- construction process. This is mostly useful for recursive parsers;
  -- see Note [Tying the knot] for more details.
  --
  -- The generality of the type here allows us to use this with multiple concrete
  -- parser types:
  --
  -- @
  -- 'memoizeOn' :: ('MonadMemoize' m, MonadParse n) => 'TH.Name' -> a -> m (Parser n b) -> m (Parser n b)
  -- 'memoizeOn' :: ('MonadMemoize' m, MonadParse n) => 'TH.Name' -> a -> m (FieldParser n b) -> m (FieldParser n b)
  -- @
  memoizeOn ::
    forall a p.
    (Ord a, Typeable a, Typeable p) =>
    -- | A unique name used to identify the function being memoized. There isn’t
    -- really any metaprogramming going on here, we just use a Template Haskell
    -- 'TH.Name' as a convenient source for a static, unique identifier.
    TH.Name ->
    -- | The value to use as the memoization key. It’s the caller’s
    -- responsibility to ensure multiple calls to the same function don’t use
    -- the same key.
    a ->
    m p ->
    m p

instance
  (MonadMemoize m) =>
  MonadMemoize (ReaderT a m)
  where
  memoizeOn :: forall a p.
(Ord a, Typeable a, Typeable p) =>
Name -> a -> ReaderT a m p -> ReaderT a m p
memoizeOn Name
name a
key = (m p -> m p) -> ReaderT a m p -> ReaderT a m p
forall (m :: * -> *) a (n :: * -> *) b r.
(m a -> n b) -> ReaderT r m a -> ReaderT r n b
mapReaderT (Name -> a -> m p -> m p
forall a p.
(Ord a, Typeable a, Typeable p) =>
Name -> a -> m p -> m p
forall (m :: * -> *) a p.
(MonadMemoize m, Ord a, Typeable a, Typeable p) =>
Name -> a -> m p -> m p
memoizeOn Name
name a
key)

-- | A wrapper around 'memoizeOn' that memoizes a function by using its argument
-- as the key.
memoize ::
  (MonadMemoize m, Ord a, Typeable a, Typeable p) =>
  TH.Name ->
  (a -> m p) ->
  (a -> m p)
memoize :: forall (m :: * -> *) a p.
(MonadMemoize m, Ord a, Typeable a, Typeable p) =>
Name -> (a -> m p) -> a -> m p
memoize Name
name a -> m p
f a
a = Name -> a -> m p -> m p
forall a p.
(Ord a, Typeable a, Typeable p) =>
Name -> a -> m p -> m p
forall (m :: * -> *) a p.
(MonadMemoize m, Ord a, Typeable a, Typeable p) =>
Name -> a -> m p -> m p
memoizeOn Name
name a
a (a -> m p
f a
a)

newtype MemoizeT m a = MemoizeT
  { forall (m :: * -> *) a.
MemoizeT m a -> StateT (DMap MemoizationKey Identity) m a
unMemoizeT :: StateT (DMap MemoizationKey Identity) m a
  }
  deriving ((forall a b. (a -> b) -> MemoizeT m a -> MemoizeT m b)
-> (forall a b. a -> MemoizeT m b -> MemoizeT m a)
-> Functor (MemoizeT m)
forall a b. a -> MemoizeT m b -> MemoizeT m a
forall a b. (a -> b) -> MemoizeT m a -> MemoizeT m b
forall (m :: * -> *) a b.
Functor m =>
a -> MemoizeT m b -> MemoizeT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MemoizeT m a -> MemoizeT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> MemoizeT m a -> MemoizeT m b
fmap :: forall a b. (a -> b) -> MemoizeT m a -> MemoizeT m b
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> MemoizeT m b -> MemoizeT m a
<$ :: forall a b. a -> MemoizeT m b -> MemoizeT m a
Functor, Functor (MemoizeT m)
Functor (MemoizeT m)
-> (forall a. a -> MemoizeT m a)
-> (forall a b.
    MemoizeT m (a -> b) -> MemoizeT m a -> MemoizeT m b)
-> (forall a b c.
    (a -> b -> c) -> MemoizeT m a -> MemoizeT m b -> MemoizeT m c)
-> (forall a b. MemoizeT m a -> MemoizeT m b -> MemoizeT m b)
-> (forall a b. MemoizeT m a -> MemoizeT m b -> MemoizeT m a)
-> Applicative (MemoizeT m)
forall a. a -> MemoizeT m a
forall a b. MemoizeT m a -> MemoizeT m b -> MemoizeT m a
forall a b. MemoizeT m a -> MemoizeT m b -> MemoizeT m b
forall a b. MemoizeT m (a -> b) -> MemoizeT m a -> MemoizeT m b
forall a b c.
(a -> b -> c) -> MemoizeT m a -> MemoizeT m b -> MemoizeT m c
forall {m :: * -> *}. Monad m => Functor (MemoizeT m)
forall (m :: * -> *) a. Monad m => a -> MemoizeT m a
forall (m :: * -> *) a b.
Monad m =>
MemoizeT m a -> MemoizeT m b -> MemoizeT m a
forall (m :: * -> *) a b.
Monad m =>
MemoizeT m a -> MemoizeT m b -> MemoizeT m b
forall (m :: * -> *) a b.
Monad m =>
MemoizeT m (a -> b) -> MemoizeT m a -> MemoizeT m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> MemoizeT m a -> MemoizeT m b -> MemoizeT m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall (m :: * -> *) a. Monad m => a -> MemoizeT m a
pure :: forall a. a -> MemoizeT m a
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
MemoizeT m (a -> b) -> MemoizeT m a -> MemoizeT m b
<*> :: forall a b. MemoizeT m (a -> b) -> MemoizeT m a -> MemoizeT m b
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> MemoizeT m a -> MemoizeT m b -> MemoizeT m c
liftA2 :: forall a b c.
(a -> b -> c) -> MemoizeT m a -> MemoizeT m b -> MemoizeT m c
$c*> :: forall (m :: * -> *) a b.
Monad m =>
MemoizeT m a -> MemoizeT m b -> MemoizeT m b
*> :: forall a b. MemoizeT m a -> MemoizeT m b -> MemoizeT m b
$c<* :: forall (m :: * -> *) a b.
Monad m =>
MemoizeT m a -> MemoizeT m b -> MemoizeT m a
<* :: forall a b. MemoizeT m a -> MemoizeT m b -> MemoizeT m a
Applicative, Applicative (MemoizeT m)
Applicative (MemoizeT m)
-> (forall a b.
    MemoizeT m a -> (a -> MemoizeT m b) -> MemoizeT m b)
-> (forall a b. MemoizeT m a -> MemoizeT m b -> MemoizeT m b)
-> (forall a. a -> MemoizeT m a)
-> Monad (MemoizeT m)
forall a. a -> MemoizeT m a
forall a b. MemoizeT m a -> MemoizeT m b -> MemoizeT m b
forall a b. MemoizeT m a -> (a -> MemoizeT m b) -> MemoizeT m b
forall (m :: * -> *). Monad m => Applicative (MemoizeT m)
forall (m :: * -> *) a. Monad m => a -> MemoizeT m a
forall (m :: * -> *) a b.
Monad m =>
MemoizeT m a -> MemoizeT m b -> MemoizeT m b
forall (m :: * -> *) a b.
Monad m =>
MemoizeT m a -> (a -> MemoizeT m b) -> MemoizeT m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
MemoizeT m a -> (a -> MemoizeT m b) -> MemoizeT m b
>>= :: forall a b. MemoizeT m a -> (a -> MemoizeT m b) -> MemoizeT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
MemoizeT m a -> MemoizeT m b -> MemoizeT m b
>> :: forall a b. MemoizeT m a -> MemoizeT m b -> MemoizeT m b
$creturn :: forall (m :: * -> *) a. Monad m => a -> MemoizeT m a
return :: forall a. a -> MemoizeT m a
Monad, MonadError e, MonadReader r, (forall (m :: * -> *) a. Monad m => m a -> MemoizeT m a)
-> MonadTrans MemoizeT
forall (m :: * -> *) a. Monad m => m a -> MemoizeT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
$clift :: forall (m :: * -> *) a. Monad m => m a -> MemoizeT m a
lift :: forall (m :: * -> *) a. Monad m => m a -> MemoizeT m a
MonadTrans)

-- | Allow code in 'MemoizeT' to have access to any underlying state capabilities,
-- hiding the fact that 'MemoizeT' itself is a state monad.
instance (MonadState s m) => MonadState s (MemoizeT m) where
  get :: MemoizeT m s
get = m s -> MemoizeT m s
forall (m :: * -> *) a. Monad m => m a -> MemoizeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m s
forall s (m :: * -> *). MonadState s m => m s
get
  put :: s -> MemoizeT m ()
put = m () -> MemoizeT m ()
forall (m :: * -> *) a. Monad m => m a -> MemoizeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> MemoizeT m ()) -> (s -> m ()) -> s -> MemoizeT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put

runMemoizeT :: forall m a. (Monad m) => MemoizeT m a -> m a
runMemoizeT :: forall (m :: * -> *) a. Monad m => MemoizeT m a -> m a
runMemoizeT = (StateT (DMap MemoizationKey Identity) m a
 -> DMap MemoizationKey Identity -> m a)
-> DMap MemoizationKey Identity
-> StateT (DMap MemoizationKey Identity) m a
-> m a
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT (DMap MemoizationKey Identity) m a
-> DMap MemoizationKey Identity -> m a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT DMap MemoizationKey Identity
forall a. Monoid a => a
mempty (StateT (DMap MemoizationKey Identity) m a -> m a)
-> (MemoizeT m a -> StateT (DMap MemoizationKey Identity) m a)
-> MemoizeT m a
-> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MemoizeT m a -> StateT (DMap MemoizationKey Identity) m a
forall (m :: * -> *) a.
MemoizeT m a -> StateT (DMap MemoizationKey Identity) m a
unMemoizeT

-- | see Note [MemoizeT requires MonadIO]
instance
  (MonadIO m) =>
  MonadMemoize (MemoizeT m)
  where
  memoizeOn :: forall a p.
(Ord a, Typeable a, Typeable p) =>
Name -> a -> MemoizeT m p -> MemoizeT m p
memoizeOn Name
name a
key MemoizeT m p
buildParser = StateT (DMap MemoizationKey Identity) m p -> MemoizeT m p
forall (m :: * -> *) a.
StateT (DMap MemoizationKey Identity) m a -> MemoizeT m a
MemoizeT do
    let parserId :: MemoizationKey p
parserId = Name -> a -> MemoizationKey p
forall a p.
(Ord a, Typeable a, Typeable p) =>
Name -> a -> MemoizationKey p
MemoizationKey Name
name a
key
    DMap MemoizationKey Identity
parsersById <- StateT
  (DMap MemoizationKey Identity) m (DMap MemoizationKey Identity)
forall s (m :: * -> *). MonadState s m => m s
get
    case MemoizationKey p
-> DMap MemoizationKey Identity -> Maybe (Identity p)
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> DMap k2 f -> Maybe (f v)
DM.lookup MemoizationKey p
parserId DMap MemoizationKey Identity
parsersById of
      Just (Identity p
parser) -> p -> StateT (DMap MemoizationKey Identity) m p
forall a. a -> StateT (DMap MemoizationKey Identity) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure p
parser
      Maybe (Identity p)
Nothing -> do
        -- We manually do eager blackholing here using a MutVar rather than
        -- relying on MonadFix and ordinary thunk blackholing. Why? A few
        -- reasons:
        --
        --   1. We have more control. We aren’t at the whims of whatever
        --      MonadFix instance happens to get used.
        --
        --   2. We can be more precise. GHC’s lazy blackholing doesn’t always
        --      kick in when you’d expect.
        --
        --   3. We can provide more useful error reporting if things go wrong.
        --      Most usefully, we can include a HasCallStack source location.
        IORef (Maybe p)
cell <- IO (IORef (Maybe p))
-> StateT (DMap MemoizationKey Identity) m (IORef (Maybe p))
forall a. IO a -> StateT (DMap MemoizationKey Identity) m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (IORef (Maybe p))
 -> StateT (DMap MemoizationKey Identity) m (IORef (Maybe p)))
-> IO (IORef (Maybe p))
-> StateT (DMap MemoizationKey Identity) m (IORef (Maybe p))
forall a b. (a -> b) -> a -> b
$ Maybe p -> IO (IORef (Maybe p))
forall a. a -> IO (IORef a)
newIORef Maybe p
forall a. Maybe a
Nothing

        -- We use unsafeInterleaveIO here, which sounds scary, but
        -- unsafeInterleaveIO is actually far more safe than unsafePerformIO.
        -- unsafeInterleaveIO just defers the execution of the action until its
        -- result is needed, adding some laziness.
        --
        -- That laziness can be dangerous if the action has side-effects, since
        -- the point at which the effect is performed can be unpredictable. But
        -- this action just reads, never writes, so that isn’t a concern.
        Identity p
parserById <-
          IO (Identity p)
-> StateT (DMap MemoizationKey Identity) m (Identity p)
forall a. IO a -> StateT (DMap MemoizationKey Identity) m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Identity p)
 -> StateT (DMap MemoizationKey Identity) m (Identity p))
-> IO (Identity p)
-> StateT (DMap MemoizationKey Identity) m (Identity p)
forall a b. (a -> b) -> a -> b
$
            IO (Identity p) -> IO (Identity p)
forall a. IO a -> IO a
unsafeInterleaveIO (IO (Identity p) -> IO (Identity p))
-> IO (Identity p) -> IO (Identity p)
forall a b. (a -> b) -> a -> b
$
              IORef (Maybe p) -> IO (Maybe p)
forall a. IORef a -> IO a
readIORef IORef (Maybe p)
cell IO (Maybe p) -> (Maybe p -> IO (Identity p)) -> IO (Identity p)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just p
parser -> Identity p -> IO (Identity p)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Identity p -> IO (Identity p)) -> Identity p -> IO (Identity p)
forall a b. (a -> b) -> a -> b
$ p -> Identity p
forall a. a -> Identity a
Identity p
parser
                Maybe p
Nothing ->
                  [Char] -> IO (Identity p)
forall a. HasCallStack => [Char] -> a
error ([Char] -> IO (Identity p)) -> [Char] -> IO (Identity p)
forall a b. (a -> b) -> a -> b
$
                    [[Char]] -> [Char]
unlines
                      [ [Char]
"memoize: parser was forced before being fully constructed",
                        [Char]
"  parser constructor: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Name -> [Char]
forall a. Ppr a => a -> [Char]
TH.pprint Name
name
                      ]
        DMap MemoizationKey Identity
-> StateT (DMap MemoizationKey Identity) m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (DMap MemoizationKey Identity
 -> StateT (DMap MemoizationKey Identity) m ())
-> DMap MemoizationKey Identity
-> StateT (DMap MemoizationKey Identity) m ()
forall a b. (a -> b) -> a -> b
$! MemoizationKey p
-> Identity p
-> DMap MemoizationKey Identity
-> DMap MemoizationKey Identity
forall {k1} (k2 :: k1 -> *) (f :: k1 -> *) (v :: k1).
GCompare k2 =>
k2 v -> f v -> DMap k2 f -> DMap k2 f
DM.insert MemoizationKey p
parserId Identity p
parserById DMap MemoizationKey Identity
parsersById

        p
parser <- MemoizeT m p -> StateT (DMap MemoizationKey Identity) m p
forall (m :: * -> *) a.
MemoizeT m a -> StateT (DMap MemoizationKey Identity) m a
unMemoizeT MemoizeT m p
buildParser
        IO () -> StateT (DMap MemoizationKey Identity) m ()
forall a. IO a -> StateT (DMap MemoizationKey Identity) m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> StateT (DMap MemoizationKey Identity) m ())
-> IO () -> StateT (DMap MemoizationKey Identity) m ()
forall a b. (a -> b) -> a -> b
$ IORef (Maybe p) -> Maybe p -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef (Maybe p)
cell (p -> Maybe p
forall a. a -> Maybe a
Just p
parser)
        p -> StateT (DMap MemoizationKey Identity) m p
forall a. a -> StateT (DMap MemoizationKey Identity) m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure p
parser

{- Note [MemoizeT requires MonadIO]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The MonadMemoize instance for MemoizeT requires MonadIO, which is unsatisfying.
The only reason the constraint is needed is to implement knot-tying via IORefs
(see Note [Tying the knot] above), which really only requires the power of
ST. Alternatively, it might be possible to use the ST monad instead, but that
has not been done for historical reasons.
-}

-- | A key used to distinguish calls to 'memoize'd functions. The 'TH.Name'
-- distinguishes calls to completely different parsers, and the @a@ value
-- records the arguments.
data MemoizationKey (t :: K.Type) where
  MemoizationKey :: (Ord a, Typeable a, Typeable p) => TH.Name -> a -> MemoizationKey p

instance GEq MemoizationKey where
  geq :: forall a b. MemoizationKey a -> MemoizationKey b -> Maybe (a :~: b)
geq
    (MemoizationKey Name
name1 (a
arg1 :: a1) :: MemoizationKey t1)
    (MemoizationKey Name
name2 (a
arg2 :: a2) :: MemoizationKey t2)
      | Name
name1 Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name2,
        Just a :~: a
Refl <- forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a1 TypeRep a -> TypeRep a -> Maybe (a :~: a)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
`geq` forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a2,
        a
arg1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a
arg2,
        Just a :~: b
Refl <- forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @t1 TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall a b. TypeRep a -> TypeRep b -> Maybe (a :~: b)
forall {k} (f :: k -> *) (a :: k) (b :: k).
GEq f =>
f a -> f b -> Maybe (a :~: b)
`geq` forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @t2 =
          (a :~: b) -> Maybe (a :~: b)
forall a. a -> Maybe a
Just a :~: a
a :~: b
forall {k} (a :: k). a :~: a
Refl
      | Bool
otherwise = Maybe (a :~: b)
forall a. Maybe a
Nothing

instance GCompare MemoizationKey where
  gcompare :: forall a b. MemoizationKey a -> MemoizationKey b -> GOrdering a b
gcompare
    (MemoizationKey Name
name1 (a
arg1 :: a1) :: MemoizationKey t1)
    (MemoizationKey Name
name2 (a
arg2 :: a2) :: MemoizationKey t2) =
      Ordering -> GOrdering Any Any
forall {k} (a :: k). Ordering -> GOrdering a a
strengthenOrdering (Name -> Name -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Name
name1 Name
name2)
        GOrdering Any Any
-> ((Any ~ Any) => GOrdering a b) -> GOrdering a b
forall {k1} {k2} (a :: k1) (b :: k1) (c :: k2) (d :: k2).
GOrdering a b -> ((a ~ b) => GOrdering c d) -> GOrdering c d
`extendGOrdering` TypeRep a -> TypeRep a -> GOrdering a a
forall a b. TypeRep a -> TypeRep b -> GOrdering a b
forall {k} (f :: k -> *) (a :: k) (b :: k).
GCompare f =>
f a -> f b -> GOrdering a b
gcompare (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a1) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @a2)
        GOrdering a a -> ((a ~ a) => GOrdering a b) -> GOrdering a b
forall {k1} {k2} (a :: k1) (b :: k1) (c :: k2) (d :: k2).
GOrdering a b -> ((a ~ b) => GOrdering c d) -> GOrdering c d
`extendGOrdering` Ordering -> GOrdering Any Any
forall {k} (a :: k). Ordering -> GOrdering a a
strengthenOrdering (a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
arg1 a
a
arg2)
        GOrdering Any Any
-> ((Any ~ Any) => GOrdering a b) -> GOrdering a b
forall {k1} {k2} (a :: k1) (b :: k1) (c :: k2) (d :: k2).
GOrdering a b -> ((a ~ b) => GOrdering c d) -> GOrdering c d
`extendGOrdering` TypeRep a -> TypeRep b -> GOrdering a b
forall a b. TypeRep a -> TypeRep b -> GOrdering a b
forall {k} (f :: k -> *) (a :: k) (b :: k).
GCompare f =>
f a -> f b -> GOrdering a b
gcompare (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @t1) (forall a. Typeable a => TypeRep a
forall {k} (a :: k). Typeable a => TypeRep a
typeRep @t2)
        GOrdering a b -> ((a ~ b) => GOrdering a b) -> GOrdering a b
forall {k1} {k2} (a :: k1) (b :: k1) (c :: k2) (d :: k2).
GOrdering a b -> ((a ~ b) => GOrdering c d) -> GOrdering c d
`extendGOrdering` GOrdering a a
GOrdering a b
(a ~ b) => GOrdering a b
forall {k} (a :: k). GOrdering a a
GEQ