{- |

This module defines a monad `Changed` that is designed for supporting
functions which take a value of some type as an argument, and may
modify it's value.

It is primarily used for abstract domains so that we know if we need
to re-explore a block when joining new edges into the state.
-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RankNTypes #-}
module Data.Macaw.Utils.Changed
  ( Changed
  , runChanged
  , markChanged
  , changedST
  ) where

import           Control.Monad.Reader
import           Control.Monad.ST
import           Data.STRef

------------------------------------------------------------------------
-- Changed

-- | A monad that can be used to record when a value is changed.
newtype Changed s a = Changed { forall s a. Changed s a -> ReaderT (STRef s Bool) (ST s) a
unChanged :: ReaderT (STRef s Bool) (ST s) a }
  deriving ((forall a b. (a -> b) -> Changed s a -> Changed s b)
-> (forall a b. a -> Changed s b -> Changed s a)
-> Functor (Changed s)
forall a b. a -> Changed s b -> Changed s a
forall a b. (a -> b) -> Changed s a -> Changed s b
forall s a b. a -> Changed s b -> Changed s a
forall s a b. (a -> b) -> Changed s a -> Changed s b
forall (f :: Type -> Type).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s a b. (a -> b) -> Changed s a -> Changed s b
fmap :: forall a b. (a -> b) -> Changed s a -> Changed s b
$c<$ :: forall s a b. a -> Changed s b -> Changed s a
<$ :: forall a b. a -> Changed s b -> Changed s a
Functor, Functor (Changed s)
Functor (Changed s) =>
(forall a. a -> Changed s a)
-> (forall a b. Changed s (a -> b) -> Changed s a -> Changed s b)
-> (forall a b c.
    (a -> b -> c) -> Changed s a -> Changed s b -> Changed s c)
-> (forall a b. Changed s a -> Changed s b -> Changed s b)
-> (forall a b. Changed s a -> Changed s b -> Changed s a)
-> Applicative (Changed s)
forall s. Functor (Changed s)
forall a. a -> Changed s a
forall s a. a -> Changed s a
forall a b. Changed s a -> Changed s b -> Changed s a
forall a b. Changed s a -> Changed s b -> Changed s b
forall a b. Changed s (a -> b) -> Changed s a -> Changed s b
forall s a b. Changed s a -> Changed s b -> Changed s a
forall s a b. Changed s a -> Changed s b -> Changed s b
forall s a b. Changed s (a -> b) -> Changed s a -> Changed s b
forall a b c.
(a -> b -> c) -> Changed s a -> Changed s b -> Changed s c
forall s a b c.
(a -> b -> c) -> Changed s a -> Changed s b -> Changed s c
forall (f :: Type -> Type).
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 s a. a -> Changed s a
pure :: forall a. a -> Changed s a
$c<*> :: forall s a b. Changed s (a -> b) -> Changed s a -> Changed s b
<*> :: forall a b. Changed s (a -> b) -> Changed s a -> Changed s b
$cliftA2 :: forall s a b c.
(a -> b -> c) -> Changed s a -> Changed s b -> Changed s c
liftA2 :: forall a b c.
(a -> b -> c) -> Changed s a -> Changed s b -> Changed s c
$c*> :: forall s a b. Changed s a -> Changed s b -> Changed s b
*> :: forall a b. Changed s a -> Changed s b -> Changed s b
$c<* :: forall s a b. Changed s a -> Changed s b -> Changed s a
<* :: forall a b. Changed s a -> Changed s b -> Changed s a
Applicative, Applicative (Changed s)
Applicative (Changed s) =>
(forall a b. Changed s a -> (a -> Changed s b) -> Changed s b)
-> (forall a b. Changed s a -> Changed s b -> Changed s b)
-> (forall a. a -> Changed s a)
-> Monad (Changed s)
forall s. Applicative (Changed s)
forall a. a -> Changed s a
forall s a. a -> Changed s a
forall a b. Changed s a -> Changed s b -> Changed s b
forall a b. Changed s a -> (a -> Changed s b) -> Changed s b
forall s a b. Changed s a -> Changed s b -> Changed s b
forall s a b. Changed s a -> (a -> Changed s b) -> Changed s b
forall (m :: Type -> Type).
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 s a b. Changed s a -> (a -> Changed s b) -> Changed s b
>>= :: forall a b. Changed s a -> (a -> Changed s b) -> Changed s b
$c>> :: forall s a b. Changed s a -> Changed s b -> Changed s b
>> :: forall a b. Changed s a -> Changed s b -> Changed s b
$creturn :: forall s a. a -> Changed s a
return :: forall a. a -> Changed s a
Monad)

-- | Run a `ST` computation.
changedST :: ST s a -> Changed s a
changedST :: forall s a. ST s a -> Changed s a
changedST ST s a
m = ReaderT (STRef s Bool) (ST s) a -> Changed s a
forall s a. ReaderT (STRef s Bool) (ST s) a -> Changed s a
Changed (ST s a -> ReaderT (STRef s Bool) (ST s) a
forall (m :: Type -> Type) a.
Monad m =>
m a -> ReaderT (STRef s Bool) m a
forall (t :: (Type -> Type) -> Type -> Type) (m :: Type -> Type) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ST s a
m)

-- | Record the value has changed if the Boolean is true.
markChanged :: Bool -> Changed s ()
markChanged :: forall s. Bool -> Changed s ()
markChanged Bool
False = () -> Changed s ()
forall a. a -> Changed s a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
markChanged Bool
True = do
  STRef s Bool
r <- ReaderT (STRef s Bool) (ST s) (STRef s Bool)
-> Changed s (STRef s Bool)
forall s a. ReaderT (STRef s Bool) (ST s) a -> Changed s a
Changed ReaderT (STRef s Bool) (ST s) (STRef s Bool)
forall r (m :: Type -> Type). MonadReader r m => m r
ask
  ST s () -> Changed s ()
forall s a. ST s a -> Changed s a
changedST (ST s () -> Changed s ()) -> ST s () -> Changed s ()
forall a b. (a -> b) -> a -> b
$ STRef s Bool -> Bool -> ST s ()
forall s a. STRef s a -> a -> ST s ()
writeSTRef STRef s Bool
r Bool
True

-- | Run the changed computation and return the value if changed,
-- and `Nothing` if not.
runChanged :: forall a . (forall s . Changed s a) -> Maybe a
runChanged :: forall a. (forall s. Changed s a) -> Maybe a
runChanged forall s. Changed s a
action = (forall s. ST s (Maybe a)) -> Maybe a
forall a. (forall s. ST s a) -> a
runST ((forall s. ST s (Maybe a)) -> Maybe a)
-> (forall s. ST s (Maybe a)) -> Maybe a
forall a b. (a -> b) -> a -> b
$ do
  STRef s Bool
r <-  Bool -> ST s (STRef s Bool)
forall a s. a -> ST s (STRef s a)
newSTRef Bool
False
  a
a <- ReaderT (STRef s Bool) (ST s) a -> STRef s Bool -> ST s a
forall r (m :: Type -> Type) a. ReaderT r m a -> r -> m a
runReaderT (Changed s a -> ReaderT (STRef s Bool) (ST s) a
forall s a. Changed s a -> ReaderT (STRef s Bool) (ST s) a
unChanged Changed s a
forall s. Changed s a
action) STRef s Bool
r
  Bool
b <- STRef s Bool -> ST s Bool
forall s a. STRef s a -> ST s a
readSTRef STRef s Bool
r
  Maybe a -> ST s (Maybe a)
forall a. a -> ST s a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Maybe a -> ST s (Maybe a)) -> Maybe a -> ST s (Maybe a)
forall a b. (a -> b) -> a -> b
$! if Bool
b then a -> Maybe a
forall a. a -> Maybe a
Just a
a else Maybe a
forall a. Maybe a
Nothing