Question

(For the following, simplify Show and Read to

class Show a where show :: a -> String
class Read a where read :: String -> a

And assume that read never fails.)

It’s well-known that one can make an existential type of the form

data ShowVal where
    ShowVal :: forall a. Show a => a -> ShowVal

And then construct a “heterogeneous list” :: [ShowVal], such as

l = [ShowVal 4, ShowVal 'Q', ShowVal True]

It’s also well-known that this is relatively useless, because, instead, one can
just construct a list :: [String], such as

l = [show 4, show 'Q', show True]

Which is exactly isomorphic (after all, the only thing one can do with a
ShowVal is show it).

Laziness makes this particularly nice, because for each value in the list, the
result of show is memoized automatically, so no String is computed more than
once (and Strings that aren’t used aren’t computed at all).

A ShowVal is equivalent to an existential tuple exists a. (a -> String, a),
where the function is the Show dictionary.

A similar construct can be made for Read:

data ReadVal where
    ReadVal :: (forall a. Read a => a) -> ReadVal

Note that, because read is polymorphic in its return value, ReadVal is
universal rather than existential (which means that we don’t really need it at
all, because Haskell has first-class universals; but we’ll use it here to
highlight the similaries to Show).

We can also make a list :: [ReadVal]:

l = [ReadVal (read "4"), ReadVal (read "'Q'"), ReadVal (read "True")]

Just as with Show, a list :: [ReadVal] is isomorphic to a list :: [String],
such as

l = ["4", "'Q'", "True"]

(We can always get the original String back with

newtype Foo = Foo String
instance Read Foo where read = Foo

Because the Read type class is open.)

A ReadVal is equivalent to a universal function forall a. (String -> a) -> a
(a CPS-style representation). Here the Read dictionary is supplied by the user
of the ReadVal rather than by the producer, because the return value is
polymorphic rather than the argument.

However, in neither of these representations do we get the automatic
memoization that we get in the String representation with Show. Let’s say that
read for our type is an expensive operation, so we don’t want to compute it
on the same String for the same type more than once.

If we had a closed type, we could do something like:

data ReadVal = ReadVal { asInt :: Int, asChar :: Char, asBool :: Bool }

And then use a value

ReadVal { asInt = read s, asChar = read s, asBool = read s }

Or something along those lines.

But in this case — even if we only ever use the ReadVal as one type — the
String will be parsed each time the value is used. Is there a simple way to
get memoization while keeping the ReadVal polymorphic?

(Getting GHC to do it automatically, similarly to the Show case, would be
ideal, if it’s somehow possible. A more explicit memoization approach —
perhaps by adding a Typeable constraint? — would also be OK.)

Answer 1

Here’s an implementation of the more explicit approach; it requires Typeable, because otherwise there’d be nothing to key the memo table on. I based the memoisation code on uglymemo; there might be a way to get this to work with pure memoisation, but I’m not sure. It’s tricky, because you have to construct the table outside of the implicit function that any forall a. (Read a, Typeable a) => ... creates, otherwise you end up constructing one table per call, which is useless.

{-# LANGUAGE GADTs, RankNTypes #-}

import Data.Dynamic
import Control.Concurrent.MVar
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM
import System.IO.Unsafe

data ReadVal where
    ReadVal :: { useReadVal :: forall a. (Read a, Typeable a) => a } -> ReadVal

mkReadVal :: String -> ReadVal
mkReadVal s = unsafePerformIO $ do
    v <- newMVar HM.empty
    return $ ReadVal (readVal v)
  where
    readVal :: (Read a, Typeable a) => MVar (HashMap TypeRep Dynamic) -> a
    readVal v = unsafePerformIO $ do
        m <- readMVar v
        let r = read s  -- not evaluated
        let typeRep = typeOf r
        case HM.lookup typeRep m of
            Nothing -> do
                modifyMVar_ v (return . HM.insert typeRep (toDyn r))
                return r
            Just r' -> return $ fromDyn r' (error "impossible")