I don't believe you can get quite the semantics you want. However, you can get reasonably close, by building a manual store and backtracking.
{-# LANGUAGE Rank2Types #-}
-- lets define an Oracle that tracks whether or not you might need the reference, by backtracking.
module Oracle
( Oracle, Ref
, newRef, readRef, writeRef, modifyRef, needRef
) where
import Control.Applicative
import Control.Arrow (first)
import Control.Monad
import Data.IntMap (IntMap)
import qualified Data.IntMap as M
import Unsafe.Coerce (unsafeCoerce)
import GHC.Prim (Any)
-- we need to track our own worlds, otherwise we'd have to build over ST, change optimistically, and track how to backtrack the state of the Store. Much uglier.
-- values are stored as 'Any's for safety, see GHC.Prim for a discussion on the hazards of risking the storage of function types using unsafeCoerce as anything else.
data World s = World { store :: !(IntMap Any), hwm :: !Int }
-- references into our store
newtype Ref s a = Ref Int deriving (Eq)
-- our monad that can 'see the future' ~ StateT (World s) []
newtype Oracle s a = Oracle { unOracle :: World s -> [(a, World s)] }
-- we rely on the fact that the list is always non-empty for any oracle you can run. we are only allowed to backtrack if we thought we wouldn't need the reference, and wound up needing it, so head will always succeed.
runOracle :: (forall s. Oracle s a) -> a
runOracle f = fst $ head $ unOracle f $ World M.empty 1
instance Monad (Oracle s) where
return a = Oracle $ \w -> [(a,w)]
Oracle m >>= k = Oracle $ \s -> do
(a,s') <- m s
unOracle (k a) s'
-- note: you cannot safely define fail here without risking a crash in runOracle
-- Similarly, we're not a MonadPlus instance because we always want to succeed eventually.
instance Functor (Oracle s) where
fmap f (Oracle g) = Oracle $ \w -> first f <$> g w
instance Applicative (Oracle s) where
pure = return
(<*>) = ap
-- new ref allocates a fresh slot and inserts the value into the store. the type level brand 's' keeps us safe, and we don't export the Ref constructor.
newRef :: a -> Oracle s (Ref s a)
newRef a = Oracle $ \(World w t) ->
[(Ref t, World (M.insert t (unsafeCoerce a) w) (t + 1))]
-- readRef is the only thing that ever backtracks, if we try to read a reference we claimed we wouldn't need, then we backtrack to when we decided we didn't need the reference, and continue with its value.
readRef :: Ref s a -> Oracle s a
readRef (Ref slot) = Oracle $ \world ->
maybe [] (\a -> [(unsafeCoerce a, world)]) $ M.lookup slot (store world)
-- note, writeRef dfoesn't 'need' the ref's current value, so needRef will report False if you writeRef before you read it after this.
writeRef :: a -> Ref s a -> Oracle s a
writeRef a (Ref slot) = Oracle $ \world ->
[(a, world { store = M.insert slot (unsafeCoerce a) $ store world })]
{-
-- alternate writeRef where writing 'needs' the ref.
writeRef :: a -> Ref s a -> Oracle s a
writeRef a (Ref slot) = Oracle $ \World store v -> do
(Just _, store') <- return $ updateLookupWithKey replace slot store
[(a, World store' v)]
where
replace _ _ = Just (unsafeCoerce a)
-}
-- modifying a reference of course needs its current value.
modifyRef :: (a -> a) -> Ref s a -> Oracle s a
modifyRef f r = do
a <- readRef r
writeRef (f a) r
-- needRef tries to continue executing the world without the element in the store in question. if that fails, then we'll backtrack to here, and try again with the original world, and report that the element was in fact needed.
needRef :: Ref s a -> Oracle s Bool
needRef (Ref slot) = Oracle $ \world ->
[ (False, world { store = M.delete slot $ store world })
, (True, world)
]
-- test case:
refMaybe b dflt ref = if b then readRef ref else return dflt
refIgnore ref = return "blablabla"
refFst ref = fst <$> readRef ref
test = do
a <- newRef "x"
b <- newRef 1
c <- newRef ('z', Just 0)
-- no performLocalGC required
x <- needRef a
y <- needRef b
z <- needRef c
u <- refMaybe y "t" a -- note that it wouldn't actually read "a",
-- but it won't be known until runtime.
w <- refIgnore b
v <- refFst c
return (x, y, z)
-- This will disagree with your desired answer, returning:
*Oracle> runOracle test
Loading package syb ... linking ... done.
Loading package array-0.2.0.0 ... linking ... done.
Loading package containers-0.2.0.1 ... linking ... done.
(False,False,True)
rather than (True, False, True), because the oracle is able to see into the future (via backtracking) to see that refMaybe doesn't use the reference after all.
This probably won't suit your needs, but it was a fun little exercise.