\begin{code}
module WirePrim where
import ListenerOps
import Remover
import IOExts
import MutSet
import TermE
import Monad
import Maybe
import Utils
import Compatibility
import Weak hiding (mkWeakPtr)
import FranTime
import BaseTypes
\end{code}


We now require to implement efficient, data driven events. 
The fundamental event operation that we must support is addListener. 
This suggests a simple, elegant representation. We simply make events
subscription functions for listeners. 

This makes the implementation of addListener trivial. We can perform 
important structural optimisations if extend the definition with an 
explicit constructor for NeverE.

We add a termination event to a general event, and add a clean-up listener 
to the termination event, where necessary, to delete any data structures 
that are no longer necessary.

\begin{code}
data Event a = Event (Listener a -> IO Remover) TermE
             | NeverE

neverE :: Event a
neverE = NeverE

-- adding a listener, don't do anything with a NeverE or NeverL
addListenerE :: Event a -> Listener a -> IO Remover
addListenerE NeverE _ = return (return ())
addListenerE _ NeverL = return (return ())
addListenerE (Event add _) l = add l

addListener e l = addListenerE e l
\end{code}


Defining a wire

\begin{code}
data Wire a = Wire {wireInput :: Listener a, wireEvent :: Event a}
\end{code}


Extracting the termination info from an event

\begin{code}
termE :: Event a -> TermE
termE (Event _ termE) = termE
termE e = hasTermE 

isTerminatedE :: Event a -> IO Bool
isTerminatedE (Event _ t) = isTerminated t
isTerminatedE NeverE = return True

onTerminateE :: Event a -> Listener () -> IO Remover
onTerminateE (Event _ t) l = onTerminate t l
onTerminateE NeverE l = return (return ())

\end{code}

The implementation is reasonably efficient in terms of time-performance, 
as it uses a data driven update mechanism. It does, however, still suffer
from a number of time and space-performance problems. We noted that 
event-caching can result in space leaks as we end up with chains of events
that will not be broken down. The event termination mechanism can solve one
class of these space leaks, by breaking down a chain from the server end. 
However, there is another class that still needs to be dealt with. We need
to be able to break down a chain from the client end. The problem with
our representation is that a listener will keep talking to the event it 
is driving, even after it has no listeners and there is no longer a reference 
to the event.

The implementation of behaviors suffers from a similar problem. Consider the 
behavior "b0 `switcherB` e" in which b0 and each new behavior generated by e 
is itself reactive. Whenever we lose interest in a reactive behavior, assuming
there are no more references to it, the state variable it contains is no 
longer useful, nor is the work it takes to update it, which may come from 
a chain of events. However, the event chain side will contain a reference 
to the state variable, so it will not be reclaimed, and neither will the 
event chain.

All this unnecessary work results in both a time-leak (as we will have 
many events chains redundantly firing) and a space-leak as these event 
chains remain redundantly in existence. We need some mechanism to prevent 
unnecessary work by breaking down event chains when they have no more real
subscribers.

We can solve these problems using weak pointers and finalisers. 
A weak pointer is a second class reference to an object, that does not 
keep the object alive. When all first-class references to an object are 
garbage collected the object will therefore be garbage collected, 
irrespective of whether there are any weak references. A Finaliser is an 
action that will be run when an object dies. 

We can therefore implement a new primitive wire constructor. This takes a 
finaliser action that will be performed when the event dies, and a termination
event.

\begin{code}
type ListenerSet a = MutSet (Occ a -> IO ())
type MainRef a = IORef (ListenerSet a,IO ())
data Status a = Passive | Dead | Active (MainRef a)


newWire :: IO (Wire a)
newWire = primNewWire' (return ()) (return ()) (return ()) neverTermE

primNewWire final sub unsub = primNewWire' final sub unsub neverTermE

primNewWire' :: IO () -> IO () -> IO () -> TermE -> IO (Wire a)
primNewWire' final sub unsub termE = do

--As before we first create a mutable listener set for the wire. 
 lset <- newMutSet 

--We also create a terminate event that will be fired when the event terminates
 (tellterm,newtermE) <- mkTermE
 tellt <- getListener tellterm
 eref <- newIORef (lset,do {t <- getTime;tellt (t,())})

--We also create a kill variable that contains a Maybe value for all the remove actions for sources that the wire's listener has been added to. The actions in this kill variable will be performed when the event dies. Once the event has been killed this Maybe ref will be set to Nothing, thereby preventing any further kill actions from being added.

 killref <- newIORef $ Just (return ()) 
 let addKill k = updIORef killref (fmap (\old -> old >> k)) 
 let fireKills = do {mb <- readIORef killref;
                     writeIORef killref Nothing;
                     maybe (return ()) id mb} 

--Initially, the event has no listeners and so its listener reference is passive.
   
 tellref <- newIORef Passive

--When the listener end or event end dies it has an action that will be run. 

 eKillRef <- newIORef (return ())
 lKillRef <- newIORef (return ())

--We make a weak reference to the listener end; its finaliser kills the event end when the tellref dies. Similarly, we make a weak reference to the event end (ie the listener set); its finaliser kills the listener end when the listener set dies.

 lwp <- mkWeakPtr tellref ( callRemover eKillRef (return ()))
 ewp <- mkWeakPtr eref ( callRemover lKillRef (return ()))

--We also add a listener to the dependent termination event, that was passed in as an argument at the start. This will also kill the event end. Note that this again uses the weak reference so that the  termE does not keep the central object alive. This is not now strictly necessary, because the wire's listener will die when the previous event terminates anyway.  However, it can result in faster destruction of event chains.

 --rmT <- onTerminate termE 
 --                   (mkL_ (do{callRemover eKillRef (return ())}))

--When the event end dies, it fires the lKillRef. This sets the tellref to Dead; fires the kill actions, to remove the wire's listener from all its source events; runs the final action; and invalidates the eKillRef, as it no longer needs to be fired. Finally, it removes the listener from the termination event, as this no longer needs to be fired.

 let alter :: (a -> IO ()) -> Weak a -> IO ()
     alter act wp = do 
       {mb <- deRefWeak wp;maybe (return ()) act mb}


 writeIORef lKillRef $ 
  do {alter (flip writeIORef Dead) lwp;fireKills;final;
      writeIORef eKillRef (return ())}

--When the listener end dies it kills the lisetner set, runs the final action and invalidates the lKillRef, as it no longer needs to be fired. It also tells the termination event that the event has terminated. 

 writeIORef eKillRef $ 
  do {alter (\ref -> do {(mset,tellt) <- readIORef ref;killMutSet mset;tellt}) ewp;
      final;writeIORef lKillRef (return ())}

--When we add an action to the event, we add it to the listener set. We also check if the listener set was previously empty, and if so we set the listener end to Active.  If the listener set has already been killed (ie has size Nothing) we do nothing.

 let --add :: Listener a -> IO Remover
     add l = do
      	(lset,_) <- readIORef eref
 	mbSz <- sizeMutSet lset
        case mbSz of 
         Nothing -> return (return ())
         Just sz -> fmap snd $ fixIO $ \ ~(rm,_) -> do
          (rmextra,fire) <- getPrimListener l rm
  	  when (sz == 0) $ alter (\r -> writeIORef r (Active eref) >> sub) lwp
	  rm <- addToMutSet lset fire
	  rm <- mkRemover (remove rm)
	  return (rm,rm>>rmextra)

--The mkRemover function makes a one-shot (idempotent) action from a simple action. We do this with remove. The remove function takes a remove action to delete an item from the mutable set and wraps it. When a listener is removed, we carry out the remove action. We also check to see if the listener set is now empty, and if so we set the listener end to Passive. Note that we use a weak reference to the listener set here so that this new remove action does not, itself, sustain the set. 

     remove :: Remover -> Remover
     remove rm = do
	  rm
  	  mb <- deRefWeak ewp
          case mb of
            Nothing -> return ()
            Just eref -> do
             (lset,_) <- readIORef eref
	     mbSz <- sizeMutSet lset
             when (maybe False (==0) mbSz) 
                  (alter (\r -> writeIORef r Passive >> unsub) lwp)

{-
To tell the event about an occurrence we must first check the listener end variable. If the reference is dead, or passive we do nothing. If it is active, we apply the occurrence. When generating the remove action we add the remover to the to the kill variable and then simply return the tel action.
-}

 let tell occ = do
	 val <- readIORef tellref
	 case val of
          Active eref -> do (set,_) <- readIORef eref
                            foreachInMutSet set ($ occ)
          _ -> return ()

 let tellL = mkL' $ \rm -> do
      addKill rm
      return tell

 return (Wire tellL (Event add newtermE))
\end{code}

There is in fact a subtle problem with the standard Weak References interface.
Standard weak pointers can have problems in GHC, because the thunks that 
weak pointers are using as keys can get optimised away. For instance, if 
readIORef is partially applied to an ioref, then the box that is holding 
the ref cell is discarded, leaving only the primitive ref cell. The weak 
pointer therefore dies as the IORef it was pointing to is gone. Instead GHC 
supports a function mkWeakIORef, which is a specialised version, of mkWeakPtr 
that works for IORefs. The key to the weak pointer is the primitive mutable 
ref cell inside the IORef box. This can't be optimised away and the IORef will
therefore stay alive. We therefore replace mkWeakPtr with mkWeakIORef.

\begin{code}

mkWeakPtr = mkWeakIORef

\end{code}
