{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE ExistentialQuantification #-}
module Symantic.Typed.ObserveSharing where
import Control.Applicative (Applicative(..))
import Control.Monad (Monad(..))
import Data.Bool (Bool(..))
import Data.Eq (Eq(..))
import Data.Foldable (foldMap)
import Data.Function (($), (.))
import Data.Functor ((<$>))
import Data.Functor.Compose (Compose(..))
import Data.HashMap.Strict (HashMap)
import Data.HashSet (HashSet)
import Data.Hashable (Hashable, hashWithSalt, hash)
import Data.Int (Int)
import Data.Maybe (Maybe(..), isNothing)
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.String (String)
import GHC.StableName (StableName(..), makeStableName, hashStableName, eqStableName)
import Prelude ((+), error)
import System.IO (IO)
import System.IO.Unsafe (unsafePerformIO)
import Text.Show (Show(..))
import qualified Control.Monad.Trans.Class as MT
import qualified Control.Monad.Trans.Reader as MT
import qualified Control.Monad.Trans.State as MT
import qualified Control.Monad.Trans.Writer as MT
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
import Symantic.Typed.Derive
class Letable letName repr where
ref :: Bool -> letName -> repr a
ref Bool
isRec letName
n = Derived repr a -> repr a
forall (repr :: * -> *) a.
LiftDerived repr =>
Derived repr a -> repr a
liftDerived (Bool -> letName -> Derived repr a
forall letName (repr :: * -> *) a.
Letable letName repr =>
Bool -> letName -> repr a
ref Bool
isRec letName
n)
default ref ::
FromDerived (Letable letName) repr =>
Bool -> letName -> repr a
shareable :: letName -> repr a -> repr a
shareable letName
n = (Derived repr a -> Derived repr a) -> repr a -> repr a
forall (repr :: * -> *) a b.
LiftDerived1 repr =>
(Derived repr a -> Derived repr b) -> repr a -> repr b
liftDerived1 (letName -> Derived repr a -> Derived repr a
forall letName (repr :: * -> *) a.
Letable letName repr =>
letName -> repr a -> repr a
shareable letName
n)
default shareable ::
FromDerived1 (Letable letName) repr =>
letName -> repr a -> repr a
class MakeLetName letName where
makeLetName :: SharingName -> IO letName
class ShowLetName (showName::Bool) letName where
showLetName :: letName -> String
instance Show letName => ShowLetName 'True letName where
showLetName :: letName -> String
showLetName = letName -> String
forall letName. Show letName => letName -> String
show
instance ShowLetName 'False letName where
showLetName :: letName -> String
showLetName letName
_p = String
"<hidden>"
data SharingName = forall a. SharingName (StableName a)
makeSharingName :: a -> SharingName
makeSharingName :: a -> SharingName
makeSharingName !a
x = StableName a -> SharingName
forall a. StableName a -> SharingName
SharingName (StableName a -> SharingName) -> StableName a -> SharingName
forall a b. (a -> b) -> a -> b
$ IO (StableName a) -> StableName a
forall a. IO a -> a
unsafePerformIO (IO (StableName a) -> StableName a)
-> IO (StableName a) -> StableName a
forall a b. (a -> b) -> a -> b
$ a -> IO (StableName a)
forall a. a -> IO (StableName a)
makeStableName a
x
instance Eq SharingName where
SharingName StableName a
x == :: SharingName -> SharingName -> Bool
== SharingName StableName a
y = StableName a -> StableName a -> Bool
forall a b. StableName a -> StableName b -> Bool
eqStableName StableName a
x StableName a
y
instance Hashable SharingName where
hash :: SharingName -> Int
hash (SharingName StableName a
n) = StableName a -> Int
forall a. StableName a -> Int
hashStableName StableName a
n
hashWithSalt :: Int -> SharingName -> Int
hashWithSalt Int
salt (SharingName StableName a
n) = Int -> StableName a -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt StableName a
n
newtype ObserveSharing letName repr a = ObserveSharing { ObserveSharing letName repr a
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
unObserveSharing ::
MT.ReaderT (HashSet SharingName)
(MT.State (ObserveSharingState letName))
(FinalizeSharing letName repr a) }
observeSharing ::
Eq letName =>
Hashable letName =>
Show letName =>
ObserveSharing letName repr a ->
WithSharing letName repr a
observeSharing :: ObserveSharing letName repr a -> WithSharing letName repr a
observeSharing (ObserveSharing ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
m) =
let (FinalizeSharing letName repr a
fs, ObserveSharingState letName
st) = ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
-> HashSet SharingName
-> State
(ObserveSharingState letName) (FinalizeSharing letName repr a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
MT.runReaderT ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
m HashSet SharingName
forall a. Monoid a => a
mempty State
(ObserveSharingState letName) (FinalizeSharing letName repr a)
-> ObserveSharingState letName
-> (FinalizeSharing letName repr a, ObserveSharingState letName)
forall s a. State s a -> s -> (a, s)
`MT.runState`
ObserveSharingState :: forall letName.
HashMap SharingName (letName, Int)
-> HashSet SharingName -> ObserveSharingState letName
ObserveSharingState
{ oss_refs :: HashMap SharingName (letName, Int)
oss_refs = HashMap SharingName (letName, Int)
forall k v. HashMap k v
HM.empty
, oss_recs :: HashSet SharingName
oss_recs = HashSet SharingName
forall a. HashSet a
HS.empty
} in
let refs :: HashSet letName
refs = [letName] -> HashSet letName
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList ([letName] -> HashSet letName) -> [letName] -> HashSet letName
forall a b. (a -> b) -> a -> b
$
(((letName, Int) -> [letName])
-> HashMap SharingName (letName, Int) -> [letName]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
`foldMap` ObserveSharingState letName -> HashMap SharingName (letName, Int)
forall letName.
ObserveSharingState letName -> HashMap SharingName (letName, Int)
oss_refs ObserveSharingState letName
st) (((letName, Int) -> [letName]) -> [letName])
-> ((letName, Int) -> [letName]) -> [letName]
forall a b. (a -> b) -> a -> b
$ (\(letName
letName, Int
refCount) ->
if Int
refCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then [letName
letName] else []) in
Writer (LetBindings letName repr) (repr a)
-> WithSharing letName repr a
forall w a. Writer w a -> (a, w)
MT.runWriter (Writer (LetBindings letName repr) (repr a)
-> WithSharing letName repr a)
-> Writer (LetBindings letName repr) (repr a)
-> WithSharing letName repr a
forall a b. (a -> b) -> a -> b
$
(ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
-> HashSet letName -> Writer (LetBindings letName repr) (repr a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
`MT.runReaderT` HashSet letName
refs) (ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
-> Writer (LetBindings letName repr) (repr a))
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
-> Writer (LetBindings letName repr) (repr a)
forall a b. (a -> b) -> a -> b
$
FinalizeSharing letName repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
forall letName (repr :: * -> *) a.
FinalizeSharing letName repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
unFinalizeSharing FinalizeSharing letName repr a
fs
data SomeLet repr = forall a. SomeLet (repr a)
type WithSharing letName repr a =
(repr a, HM.HashMap letName (SomeLet repr))
data ObserveSharingState letName = ObserveSharingState
{ ObserveSharingState letName -> HashMap SharingName (letName, Int)
oss_refs :: HashMap SharingName (letName, Int)
, ObserveSharingState letName -> HashSet SharingName
oss_recs :: HashSet SharingName
}
observeSharingNode ::
Eq letName =>
Hashable letName =>
Show letName =>
Letable letName repr =>
MakeLetName letName =>
ObserveSharing letName repr a ->
ObserveSharing letName repr a
observeSharingNode :: ObserveSharing letName repr a -> ObserveSharing letName repr a
observeSharingNode (ObserveSharing ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
m) = ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
-> ObserveSharing letName repr a
forall letName (repr :: * -> *) a.
ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
-> ObserveSharing letName repr a
ObserveSharing (ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
-> ObserveSharing letName repr a)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
-> ObserveSharing letName repr a
forall a b. (a -> b) -> a -> b
$ do
let nodeName :: SharingName
nodeName = ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
-> SharingName
forall a. a -> SharingName
makeSharingName ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
m
ObserveSharingState letName
st <- StateT
(ObserveSharingState letName)
Identity
(ObserveSharingState letName)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(ObserveSharingState letName)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift StateT
(ObserveSharingState letName)
Identity
(ObserveSharingState letName)
forall (m :: * -> *) s. Monad m => StateT s m s
MT.get
((letName
letName, Maybe (letName, Int)
before), HashMap SharingName (letName, Int)
preds) <- Compose
(ReaderT
(HashSet SharingName) (State (ObserveSharingState letName)))
((,) (letName, Maybe (letName, Int)))
(HashMap SharingName (letName, Int))
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
((letName, Maybe (letName, Int)),
HashMap SharingName (letName, Int))
forall k1 (f :: k1 -> *) k2 (g :: k2 -> k1) (a :: k2).
Compose f g a -> f (g a)
getCompose (Compose
(ReaderT
(HashSet SharingName) (State (ObserveSharingState letName)))
((,) (letName, Maybe (letName, Int)))
(HashMap SharingName (letName, Int))
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
((letName, Maybe (letName, Int)),
HashMap SharingName (letName, Int)))
-> Compose
(ReaderT
(HashSet SharingName) (State (ObserveSharingState letName)))
((,) (letName, Maybe (letName, Int)))
(HashMap SharingName (letName, Int))
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
((letName, Maybe (letName, Int)),
HashMap SharingName (letName, Int))
forall a b. (a -> b) -> a -> b
$ (Maybe (letName, Int)
-> Compose
(ReaderT
(HashSet SharingName) (State (ObserveSharingState letName)))
((,) (letName, Maybe (letName, Int)))
(Maybe (letName, Int)))
-> SharingName
-> HashMap SharingName (letName, Int)
-> Compose
(ReaderT
(HashSet SharingName) (State (ObserveSharingState letName)))
((,) (letName, Maybe (letName, Int)))
(HashMap SharingName (letName, Int))
forall (f :: * -> *) k v.
(Functor f, Eq k, Hashable k) =>
(Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
HM.alterF (\Maybe (letName, Int)
before ->
ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
((letName, Maybe (letName, Int)), Maybe (letName, Int))
-> Compose
(ReaderT
(HashSet SharingName) (State (ObserveSharingState letName)))
((,) (letName, Maybe (letName, Int)))
(Maybe (letName, Int))
forall k k1 (f :: k -> *) (g :: k1 -> k) (a :: k1).
f (g a) -> Compose f g a
Compose (ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
((letName, Maybe (letName, Int)), Maybe (letName, Int))
-> Compose
(ReaderT
(HashSet SharingName) (State (ObserveSharingState letName)))
((,) (letName, Maybe (letName, Int)))
(Maybe (letName, Int)))
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
((letName, Maybe (letName, Int)), Maybe (letName, Int))
-> Compose
(ReaderT
(HashSet SharingName) (State (ObserveSharingState letName)))
((,) (letName, Maybe (letName, Int)))
(Maybe (letName, Int))
forall a b. (a -> b) -> a -> b
$ case Maybe (letName, Int)
before of
Maybe (letName, Int)
Nothing -> do
let letName :: letName
letName = IO letName -> letName
forall a. IO a -> a
unsafePerformIO (IO letName -> letName) -> IO letName -> letName
forall a b. (a -> b) -> a -> b
$ SharingName -> IO letName
forall letName. MakeLetName letName => SharingName -> IO letName
makeLetName SharingName
nodeName
((letName, Maybe (letName, Int)), Maybe (letName, Int))
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
((letName, Maybe (letName, Int)), Maybe (letName, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return ((letName
letName, Maybe (letName, Int)
before), (letName, Int) -> Maybe (letName, Int)
forall a. a -> Maybe a
Just (letName
letName, Int
0))
Just (letName
letName, Int
refCount) -> do
((letName, Maybe (letName, Int)), Maybe (letName, Int))
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
((letName, Maybe (letName, Int)), Maybe (letName, Int))
forall (m :: * -> *) a. Monad m => a -> m a
return ((letName
letName, Maybe (letName, Int)
before), (letName, Int) -> Maybe (letName, Int)
forall a. a -> Maybe a
Just (letName
letName, Int
refCount Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
) SharingName
nodeName (ObserveSharingState letName -> HashMap SharingName (letName, Int)
forall letName.
ObserveSharingState letName -> HashMap SharingName (letName, Int)
oss_refs ObserveSharingState letName
st)
HashSet SharingName
parentNames <- ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(HashSet SharingName)
forall (m :: * -> *) r. Monad m => ReaderT r m r
MT.ask
if SharingName
nodeName SharingName -> HashSet SharingName -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet SharingName
parentNames
then do
StateT (ObserveSharingState letName) Identity ()
-> ReaderT
(HashSet SharingName) (State (ObserveSharingState letName)) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (StateT (ObserveSharingState letName) Identity ()
-> ReaderT
(HashSet SharingName) (State (ObserveSharingState letName)) ())
-> StateT (ObserveSharingState letName) Identity ()
-> ReaderT
(HashSet SharingName) (State (ObserveSharingState letName)) ()
forall a b. (a -> b) -> a -> b
$ ObserveSharingState letName
-> StateT (ObserveSharingState letName) Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
MT.put ObserveSharingState letName
st
{ oss_refs :: HashMap SharingName (letName, Int)
oss_refs = HashMap SharingName (letName, Int)
preds
, oss_recs :: HashSet SharingName
oss_recs = SharingName -> HashSet SharingName -> HashSet SharingName
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HS.insert SharingName
nodeName (ObserveSharingState letName -> HashSet SharingName
forall letName. ObserveSharingState letName -> HashSet SharingName
oss_recs ObserveSharingState letName
st)
}
FinalizeSharing letName repr a
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FinalizeSharing letName repr a
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a))
-> FinalizeSharing letName repr a
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
forall a b. (a -> b) -> a -> b
$ Bool -> letName -> FinalizeSharing letName repr a
forall letName (repr :: * -> *) a.
Letable letName repr =>
Bool -> letName -> repr a
ref Bool
True letName
letName
else do
StateT (ObserveSharingState letName) Identity ()
-> ReaderT
(HashSet SharingName) (State (ObserveSharingState letName)) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (StateT (ObserveSharingState letName) Identity ()
-> ReaderT
(HashSet SharingName) (State (ObserveSharingState letName)) ())
-> StateT (ObserveSharingState letName) Identity ()
-> ReaderT
(HashSet SharingName) (State (ObserveSharingState letName)) ()
forall a b. (a -> b) -> a -> b
$ ObserveSharingState letName
-> StateT (ObserveSharingState letName) Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
MT.put ObserveSharingState letName
st{ oss_refs :: HashMap SharingName (letName, Int)
oss_refs = HashMap SharingName (letName, Int)
preds }
if Maybe (letName, Int) -> Bool
forall a. Maybe a -> Bool
isNothing Maybe (letName, Int)
before
then (HashSet SharingName -> HashSet SharingName)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
forall r (m :: * -> *) a.
(r -> r) -> ReaderT r m a -> ReaderT r m a
MT.local (SharingName -> HashSet SharingName -> HashSet SharingName
forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
HS.insert SharingName
nodeName) (letName
-> FinalizeSharing letName repr a -> FinalizeSharing letName repr a
forall letName (repr :: * -> *) a.
Letable letName repr =>
letName -> repr a -> repr a
shareable letName
letName (FinalizeSharing letName repr a -> FinalizeSharing letName repr a)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
m)
else FinalizeSharing letName repr a
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
forall (m :: * -> *) a. Monad m => a -> m a
return (FinalizeSharing letName repr a
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a))
-> FinalizeSharing letName repr a
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
forall a b. (a -> b) -> a -> b
$ Bool -> letName -> FinalizeSharing letName repr a
forall letName (repr :: * -> *) a.
Letable letName repr =>
Bool -> letName -> repr a
ref Bool
False letName
letName
type instance Derived (ObserveSharing letName repr) = FinalizeSharing letName repr
instance
( Letable letName repr
, MakeLetName letName
, Eq letName
, Hashable letName
, Show letName
) => LiftDerived (ObserveSharing letName repr) where
liftDerived :: Derived (ObserveSharing letName repr) a
-> ObserveSharing letName repr a
liftDerived = ObserveSharing letName repr a -> ObserveSharing letName repr a
forall letName (repr :: * -> *) a.
(Eq letName, Hashable letName, Show letName, Letable letName repr,
MakeLetName letName) =>
ObserveSharing letName repr a -> ObserveSharing letName repr a
observeSharingNode (ObserveSharing letName repr a -> ObserveSharing letName repr a)
-> (FinalizeSharing letName repr a
-> ObserveSharing letName repr a)
-> FinalizeSharing letName repr a
-> ObserveSharing letName repr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
-> ObserveSharing letName repr a
forall letName (repr :: * -> *) a.
ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
-> ObserveSharing letName repr a
ObserveSharing (ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
-> ObserveSharing letName repr a)
-> (FinalizeSharing letName repr a
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a))
-> FinalizeSharing letName repr a
-> ObserveSharing letName repr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FinalizeSharing letName repr a
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
forall (m :: * -> *) a. Monad m => a -> m a
return
instance
( Letable letName repr
, MakeLetName letName
, Eq letName
, Hashable letName
, Show letName
) => LiftDerived1 (ObserveSharing letName repr) where
liftDerived1 :: (Derived (ObserveSharing letName repr) a
-> Derived (ObserveSharing letName repr) b)
-> ObserveSharing letName repr a -> ObserveSharing letName repr b
liftDerived1 Derived (ObserveSharing letName repr) a
-> Derived (ObserveSharing letName repr) b
f ObserveSharing letName repr a
x = ObserveSharing letName repr b -> ObserveSharing letName repr b
forall letName (repr :: * -> *) a.
(Eq letName, Hashable letName, Show letName, Letable letName repr,
MakeLetName letName) =>
ObserveSharing letName repr a -> ObserveSharing letName repr a
observeSharingNode (ObserveSharing letName repr b -> ObserveSharing letName repr b)
-> ObserveSharing letName repr b -> ObserveSharing letName repr b
forall a b. (a -> b) -> a -> b
$ ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr b)
-> ObserveSharing letName repr b
forall letName (repr :: * -> *) a.
ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
-> ObserveSharing letName repr a
ObserveSharing (ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr b)
-> ObserveSharing letName repr b)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr b)
-> ObserveSharing letName repr b
forall a b. (a -> b) -> a -> b
$
Derived (ObserveSharing letName repr) a
-> Derived (ObserveSharing letName repr) b
FinalizeSharing letName repr a -> FinalizeSharing letName repr b
f (FinalizeSharing letName repr a -> FinalizeSharing letName repr b)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ObserveSharing letName repr a
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
forall letName (repr :: * -> *) a.
ObserveSharing letName repr a
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
unObserveSharing ObserveSharing letName repr a
x
instance
( Letable letName repr
, MakeLetName letName
, Eq letName
, Hashable letName
, Show letName
) => LiftDerived2 (ObserveSharing letName repr) where
liftDerived2 :: (Derived (ObserveSharing letName repr) a
-> Derived (ObserveSharing letName repr) b
-> Derived (ObserveSharing letName repr) c)
-> ObserveSharing letName repr a
-> ObserveSharing letName repr b
-> ObserveSharing letName repr c
liftDerived2 Derived (ObserveSharing letName repr) a
-> Derived (ObserveSharing letName repr) b
-> Derived (ObserveSharing letName repr) c
f ObserveSharing letName repr a
x ObserveSharing letName repr b
y = ObserveSharing letName repr c -> ObserveSharing letName repr c
forall letName (repr :: * -> *) a.
(Eq letName, Hashable letName, Show letName, Letable letName repr,
MakeLetName letName) =>
ObserveSharing letName repr a -> ObserveSharing letName repr a
observeSharingNode (ObserveSharing letName repr c -> ObserveSharing letName repr c)
-> ObserveSharing letName repr c -> ObserveSharing letName repr c
forall a b. (a -> b) -> a -> b
$ ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr c)
-> ObserveSharing letName repr c
forall letName (repr :: * -> *) a.
ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
-> ObserveSharing letName repr a
ObserveSharing (ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr c)
-> ObserveSharing letName repr c)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr c)
-> ObserveSharing letName repr c
forall a b. (a -> b) -> a -> b
$
Derived (ObserveSharing letName repr) a
-> Derived (ObserveSharing letName repr) b
-> Derived (ObserveSharing letName repr) c
FinalizeSharing letName repr a
-> FinalizeSharing letName repr b -> FinalizeSharing letName repr c
f (FinalizeSharing letName repr a
-> FinalizeSharing letName repr b
-> FinalizeSharing letName repr c)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr b -> FinalizeSharing letName repr c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ObserveSharing letName repr a
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
forall letName (repr :: * -> *) a.
ObserveSharing letName repr a
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
unObserveSharing ObserveSharing letName repr a
x
ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr b -> FinalizeSharing letName repr c)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr b)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ObserveSharing letName repr b
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr b)
forall letName (repr :: * -> *) a.
ObserveSharing letName repr a
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
unObserveSharing ObserveSharing letName repr b
y
instance
( Letable letName repr
, MakeLetName letName
, Eq letName
, Hashable letName
, Show letName
) => LiftDerived3 (ObserveSharing letName repr) where
liftDerived3 :: (Derived (ObserveSharing letName repr) a
-> Derived (ObserveSharing letName repr) b
-> Derived (ObserveSharing letName repr) c
-> Derived (ObserveSharing letName repr) d)
-> ObserveSharing letName repr a
-> ObserveSharing letName repr b
-> ObserveSharing letName repr c
-> ObserveSharing letName repr d
liftDerived3 Derived (ObserveSharing letName repr) a
-> Derived (ObserveSharing letName repr) b
-> Derived (ObserveSharing letName repr) c
-> Derived (ObserveSharing letName repr) d
f ObserveSharing letName repr a
x ObserveSharing letName repr b
y ObserveSharing letName repr c
z = ObserveSharing letName repr d -> ObserveSharing letName repr d
forall letName (repr :: * -> *) a.
(Eq letName, Hashable letName, Show letName, Letable letName repr,
MakeLetName letName) =>
ObserveSharing letName repr a -> ObserveSharing letName repr a
observeSharingNode (ObserveSharing letName repr d -> ObserveSharing letName repr d)
-> ObserveSharing letName repr d -> ObserveSharing letName repr d
forall a b. (a -> b) -> a -> b
$ ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr d)
-> ObserveSharing letName repr d
forall letName (repr :: * -> *) a.
ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
-> ObserveSharing letName repr a
ObserveSharing (ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr d)
-> ObserveSharing letName repr d)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr d)
-> ObserveSharing letName repr d
forall a b. (a -> b) -> a -> b
$
Derived (ObserveSharing letName repr) a
-> Derived (ObserveSharing letName repr) b
-> Derived (ObserveSharing letName repr) c
-> Derived (ObserveSharing letName repr) d
FinalizeSharing letName repr a
-> FinalizeSharing letName repr b
-> FinalizeSharing letName repr c
-> FinalizeSharing letName repr d
f (FinalizeSharing letName repr a
-> FinalizeSharing letName repr b
-> FinalizeSharing letName repr c
-> FinalizeSharing letName repr d)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr b
-> FinalizeSharing letName repr c
-> FinalizeSharing letName repr d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ObserveSharing letName repr a
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
forall letName (repr :: * -> *) a.
ObserveSharing letName repr a
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
unObserveSharing ObserveSharing letName repr a
x
ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr b
-> FinalizeSharing letName repr c
-> FinalizeSharing letName repr d)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr b)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr c -> FinalizeSharing letName repr d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ObserveSharing letName repr b
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr b)
forall letName (repr :: * -> *) a.
ObserveSharing letName repr a
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
unObserveSharing ObserveSharing letName repr b
y
ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr c -> FinalizeSharing letName repr d)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr c)
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ObserveSharing letName repr c
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr c)
forall letName (repr :: * -> *) a.
ObserveSharing letName repr a
-> ReaderT
(HashSet SharingName)
(State (ObserveSharingState letName))
(FinalizeSharing letName repr a)
unObserveSharing ObserveSharing letName repr c
z
instance Letable letName (ObserveSharing letName repr) where
shareable :: letName
-> ObserveSharing letName repr a -> ObserveSharing letName repr a
shareable = String
-> letName
-> ObserveSharing letName repr a
-> ObserveSharing letName repr a
forall a. HasCallStack => String -> a
error String
"[BUG]: observeSharing MUST NOT be applied twice"
ref :: Bool -> letName -> ObserveSharing letName repr a
ref = String -> Bool -> letName -> ObserveSharing letName repr a
forall a. HasCallStack => String -> a
error String
"[BUG]: observeSharing MUST NOT be applied twice"
instance Letsable letName (ObserveSharing letName repr) where
lets :: LetBindings letName (ObserveSharing letName repr)
-> ObserveSharing letName repr a -> ObserveSharing letName repr a
lets = String
-> LetBindings letName (ObserveSharing letName repr)
-> ObserveSharing letName repr a
-> ObserveSharing letName repr a
forall a. HasCallStack => String -> a
error String
"[BUG]: observeSharing MUST NOT be applied twice"
newtype FinalizeSharing letName repr a = FinalizeSharing { FinalizeSharing letName repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
unFinalizeSharing ::
MT.ReaderT (HS.HashSet letName)
(MT.Writer (LetBindings letName repr))
(repr a) }
type LetBindings letName repr = HM.HashMap letName (SomeLet repr)
type instance Derived (FinalizeSharing _letName repr) = repr
instance
( Eq letName
, Hashable letName
) => LiftDerived (FinalizeSharing letName repr) where
liftDerived :: Derived (FinalizeSharing letName repr) a
-> FinalizeSharing letName repr a
liftDerived = ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
-> FinalizeSharing letName repr a
forall letName (repr :: * -> *) a.
ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
-> FinalizeSharing letName repr a
FinalizeSharing (ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
-> FinalizeSharing letName repr a)
-> (repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a))
-> repr a
-> FinalizeSharing letName repr a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance
( Eq letName
, Hashable letName
) => LiftDerived1 (FinalizeSharing letName repr) where
liftDerived1 :: (Derived (FinalizeSharing letName repr) a
-> Derived (FinalizeSharing letName repr) b)
-> FinalizeSharing letName repr a -> FinalizeSharing letName repr b
liftDerived1 Derived (FinalizeSharing letName repr) a
-> Derived (FinalizeSharing letName repr) b
f FinalizeSharing letName repr a
x = ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr b)
-> FinalizeSharing letName repr b
forall letName (repr :: * -> *) a.
ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
-> FinalizeSharing letName repr a
FinalizeSharing (ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr b)
-> FinalizeSharing letName repr b)
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr b)
-> FinalizeSharing letName repr b
forall a b. (a -> b) -> a -> b
$ repr a -> repr b
Derived (FinalizeSharing letName repr) a
-> Derived (FinalizeSharing letName repr) b
f (repr a -> repr b)
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizeSharing letName repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
forall letName (repr :: * -> *) a.
FinalizeSharing letName repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
unFinalizeSharing FinalizeSharing letName repr a
x
instance
( Eq letName
, Hashable letName
) => LiftDerived2 (FinalizeSharing letName repr) where
liftDerived2 :: (Derived (FinalizeSharing letName repr) a
-> Derived (FinalizeSharing letName repr) b
-> Derived (FinalizeSharing letName repr) c)
-> FinalizeSharing letName repr a
-> FinalizeSharing letName repr b
-> FinalizeSharing letName repr c
liftDerived2 Derived (FinalizeSharing letName repr) a
-> Derived (FinalizeSharing letName repr) b
-> Derived (FinalizeSharing letName repr) c
f FinalizeSharing letName repr a
x FinalizeSharing letName repr b
y = ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr c)
-> FinalizeSharing letName repr c
forall letName (repr :: * -> *) a.
ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
-> FinalizeSharing letName repr a
FinalizeSharing (ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr c)
-> FinalizeSharing letName repr c)
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr c)
-> FinalizeSharing letName repr c
forall a b. (a -> b) -> a -> b
$
repr a -> repr b -> repr c
Derived (FinalizeSharing letName repr) a
-> Derived (FinalizeSharing letName repr) b
-> Derived (FinalizeSharing letName repr) c
f (repr a -> repr b -> repr c)
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
-> ReaderT
(HashSet letName)
(Writer (LetBindings letName repr))
(repr b -> repr c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizeSharing letName repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
forall letName (repr :: * -> *) a.
FinalizeSharing letName repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
unFinalizeSharing FinalizeSharing letName repr a
x
ReaderT
(HashSet letName)
(Writer (LetBindings letName repr))
(repr b -> repr c)
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr b)
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr c)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FinalizeSharing letName repr b
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr b)
forall letName (repr :: * -> *) a.
FinalizeSharing letName repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
unFinalizeSharing FinalizeSharing letName repr b
y
instance
( Eq letName
, Hashable letName
) => LiftDerived3 (FinalizeSharing letName repr) where
liftDerived3 :: (Derived (FinalizeSharing letName repr) a
-> Derived (FinalizeSharing letName repr) b
-> Derived (FinalizeSharing letName repr) c
-> Derived (FinalizeSharing letName repr) d)
-> FinalizeSharing letName repr a
-> FinalizeSharing letName repr b
-> FinalizeSharing letName repr c
-> FinalizeSharing letName repr d
liftDerived3 Derived (FinalizeSharing letName repr) a
-> Derived (FinalizeSharing letName repr) b
-> Derived (FinalizeSharing letName repr) c
-> Derived (FinalizeSharing letName repr) d
f FinalizeSharing letName repr a
x FinalizeSharing letName repr b
y FinalizeSharing letName repr c
z = ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr d)
-> FinalizeSharing letName repr d
forall letName (repr :: * -> *) a.
ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
-> FinalizeSharing letName repr a
FinalizeSharing (ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr d)
-> FinalizeSharing letName repr d)
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr d)
-> FinalizeSharing letName repr d
forall a b. (a -> b) -> a -> b
$
repr a -> repr b -> repr c -> repr d
Derived (FinalizeSharing letName repr) a
-> Derived (FinalizeSharing letName repr) b
-> Derived (FinalizeSharing letName repr) c
-> Derived (FinalizeSharing letName repr) d
f (repr a -> repr b -> repr c -> repr d)
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
-> ReaderT
(HashSet letName)
(Writer (LetBindings letName repr))
(repr b -> repr c -> repr d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FinalizeSharing letName repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
forall letName (repr :: * -> *) a.
FinalizeSharing letName repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
unFinalizeSharing FinalizeSharing letName repr a
x
ReaderT
(HashSet letName)
(Writer (LetBindings letName repr))
(repr b -> repr c -> repr d)
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr b)
-> ReaderT
(HashSet letName)
(Writer (LetBindings letName repr))
(repr c -> repr d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FinalizeSharing letName repr b
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr b)
forall letName (repr :: * -> *) a.
FinalizeSharing letName repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
unFinalizeSharing FinalizeSharing letName repr b
y
ReaderT
(HashSet letName)
(Writer (LetBindings letName repr))
(repr c -> repr d)
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr c)
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FinalizeSharing letName repr c
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr c)
forall letName (repr :: * -> *) a.
FinalizeSharing letName repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
unFinalizeSharing FinalizeSharing letName repr c
z
instance
( Letable letName repr
, Eq letName
, Hashable letName
, Show letName
) => Letable letName (FinalizeSharing letName repr) where
shareable :: letName
-> FinalizeSharing letName repr a -> FinalizeSharing letName repr a
shareable letName
name FinalizeSharing letName repr a
x = ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
-> FinalizeSharing letName repr a
forall letName (repr :: * -> *) a.
ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
-> FinalizeSharing letName repr a
FinalizeSharing (ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
-> FinalizeSharing letName repr a)
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
-> FinalizeSharing letName repr a
forall a b. (a -> b) -> a -> b
$ do
HashSet letName
refs <- ReaderT
(HashSet letName)
(Writer (LetBindings letName repr))
(HashSet letName)
forall (m :: * -> *) r. Monad m => ReaderT r m r
MT.ask
if letName
name letName -> HashSet letName -> Bool
forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
`HS.member` HashSet letName
refs
then do
let (repr a
repr, LetBindings letName repr
defs) = Writer (LetBindings letName repr) (repr a)
-> (repr a, LetBindings letName repr)
forall w a. Writer w a -> (a, w)
MT.runWriter (Writer (LetBindings letName repr) (repr a)
-> (repr a, LetBindings letName repr))
-> Writer (LetBindings letName repr) (repr a)
-> (repr a, LetBindings letName repr)
forall a b. (a -> b) -> a -> b
$ ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
-> HashSet letName -> Writer (LetBindings letName repr) (repr a)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
MT.runReaderT (FinalizeSharing letName repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
forall letName (repr :: * -> *) a.
FinalizeSharing letName repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
unFinalizeSharing FinalizeSharing letName repr a
x) HashSet letName
refs
WriterT (LetBindings letName repr) Identity ()
-> ReaderT (HashSet letName) (Writer (LetBindings letName repr)) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
MT.lift (WriterT (LetBindings letName repr) Identity ()
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) ())
-> WriterT (LetBindings letName repr) Identity ()
-> ReaderT (HashSet letName) (Writer (LetBindings letName repr)) ()
forall a b. (a -> b) -> a -> b
$ LetBindings letName repr
-> WriterT (LetBindings letName repr) Identity ()
forall (m :: * -> *) w. Monad m => w -> WriterT w m ()
MT.tell (LetBindings letName repr
-> WriterT (LetBindings letName repr) Identity ())
-> LetBindings letName repr
-> WriterT (LetBindings letName repr) Identity ()
forall a b. (a -> b) -> a -> b
$ letName
-> SomeLet repr
-> LetBindings letName repr
-> LetBindings letName repr
forall k v.
(Eq k, Hashable k) =>
k -> v -> HashMap k v -> HashMap k v
HM.insert letName
name (repr a -> SomeLet repr
forall (repr :: * -> *) a. repr a -> SomeLet repr
SomeLet repr a
repr) LetBindings letName repr
defs
repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
forall (m :: * -> *) a. Monad m => a -> m a
return (repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a))
-> repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
forall a b. (a -> b) -> a -> b
$ Bool -> letName -> repr a
forall letName (repr :: * -> *) a.
Letable letName repr =>
Bool -> letName -> repr a
ref Bool
False letName
name
else
FinalizeSharing letName repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
forall letName (repr :: * -> *) a.
FinalizeSharing letName repr a
-> ReaderT
(HashSet letName) (Writer (LetBindings letName repr)) (repr a)
unFinalizeSharing FinalizeSharing letName repr a
x
class Letsable letName repr where
lets :: LetBindings letName repr -> repr a -> repr a
lets LetBindings letName repr
defs = (Derived repr a -> Derived repr a) -> repr a -> repr a
forall (repr :: * -> *) a b.
LiftDerived1 repr =>
(Derived repr a -> Derived repr b) -> repr a -> repr b
liftDerived1 (LetBindings letName (Derived repr)
-> Derived repr a -> Derived repr a
forall letName (repr :: * -> *) a.
Letsable letName repr =>
LetBindings letName repr -> repr a -> repr a
lets ((\(SomeLet repr a
val) -> Derived repr a -> SomeLet (Derived repr)
forall (repr :: * -> *) a. repr a -> SomeLet repr
SomeLet (repr a -> Derived repr a
forall (repr :: * -> *) a.
Derivable repr =>
repr a -> Derived repr a
derive repr a
val)) (SomeLet repr -> SomeLet (Derived repr))
-> LetBindings letName repr -> LetBindings letName (Derived repr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LetBindings letName repr
defs))
default lets ::
Derivable repr =>
FromDerived1 (Letsable letName) repr =>
LetBindings letName repr -> repr a -> repr a